代码学习分享

Allen2018

=============================赠人玫瑰，手留余香================================

实践中,经常调用一些代码,这些代码或从论坛搜索收集而来,或向各位老师求助而来,或从所购书本中摘抄而来,或自己摸索编写而来,为便于统一查找调用,我计划花费一些时间将他们逐一归集,方便自己的同时也希望能帮到有需求的朋友,各位老师若是发现我所归集的代码涉嫌侵犯您的权益,请告知我,我将及时修正不当内容!

========================各位若有更为优化的算法请回复,谢谢您!==========================

Allen2018

一、自定义函数
自定义函数：返回 Column 英文字
自定义函数：查询某一列某值第n次出现左边某列的值
自定义函数：从形如"123545ABCDE"的字符串中取出数字
自定义函数：从形如"ABCD12455EDF"的字符串中取出数字


二、工作表基础函数

三、算法类函数

四、专业财务函数

五、财经类函数

Allen2018

'################################################################
'1.函数作用：返回 Column 英文字
'################################################################

Function ColLetter(ColNumber As Integer) As String
    On Error GoTo Errorhandler
    ColLetter = Left(Cells(1, ColNumber).Address(0, 0), 1 - (ColNumber > 26))
    Exit Function
Errorhandler:
    MsgBox "Error encountered, please re-enter "
End Function

Allen2018

'################################################################
'2.函数作用：查询某一列第num次出现的值
'  参数说明：Value1：查询引用的数值;
'            Range1：查询区域;
'            num：指定查询第几次出现;
'            Col：返回值, 相对引用区域, 相对引用列的右边第Col列的值
'################################################################

Function MyFind(Value1, ByVal Range1 As Range, ByVal num As Integer, ByVal Col As Integer)
    If Value1 = "" Then Exit Function
    If Range1.Columns.Count > 1 Then Exit Function
    For Each D In Range1
        If D.Value = Value1 Then
            c = c + 1
            If c = num Then
                v1 = D(1, Col)
                Exit For
            End If
        ElseIf IsEmpty(D) Then
            Exit For
        End If
    Next
    If v1 = "" Then v1 = "not"
    MyFind = v1
End Function

Allen2018

Allen2018 发表于 2017-3-14 21:08
'################################################################
'2.函数作用：查询某一列第num次出 ...

示例：MyFind(1, Range("E:E"), 1, 2)
即，e列 1 第一次出现位置 的 相对位置 往右 本列其实 第2列的 值

Allen2018

'################################################################
'4.函数作用：从形如"123545ABCDE"的字符串中取出数字
'################################################################

Function myvalue(mystring As String) As Double
    myvalue = Val(mystring)
End Function

Allen2018

'################################################################
'5.函数作用：从形如"ABCD12455EDF"的字符串中取出数字
'################################################################

Function mydata(mystring As String) As Double
    Dim i As Integer
    i = 1
    Do Until Val(Mid(mystring, i, 1)) > 0
        i = i + 1
    Loop
    mydata = Val(Mid(mystring, i, Len(mystring) - i + 1))
End Function

Allen2018

'################################################################
'6.函数作用：按SplitType取得RangeName串值中的起始位置
'################################################################

'1:单元格，2:行号，3:列号，4:范围
Public Const SINGLE_CELL = 1
Public Const ROW_NUM = 2
Public Const COL_NUM = 3
Public Const RANGE_ALL = 4

Public Function SplitRangeName(RangeName As String, SplitType As Integer) As String
    If VBA.Len(RangeName) < 3 Then
        Exit Function
    Else
        RangeName = VBA.Right(RangeName, VBA.Len(RangeName) - VBA.InStr(1, RangeName, "!") - 1)
        If VBA.InStr(1, RangeName, ":") > 0 Then RangeName = VBA.Left(RangeName, VBA.InStr(1, RangeName, ":") - 1)
        Select Case SplitType
            Case SINGLE_CELL
                If VBA.InStr(1, RangeName, ":") <> 0 Then
                    SplitRangeName = "$" & VBA.Left(RangeName, VBA.InStr(1, RangeName, ":") - 1)
                Else
                    SplitRangeName = "$" & RangeName
                End If
            Case ROW_NUM
                SplitRangeName = VBA.IIf(VBA.InStr(1, RangeName, "$") > 0, VBA.Right(RangeName, VBA.Len(RangeName) - VBA.InStr(1, RangeName, "$")), RangeName)
                If Not IsNumeric(SplitRangeName) Then
                    SplitRangeName = ""
                    MsgBox "", vbInformation, ""
                End If
            Case COL_NUM
                If VBA.InStr(1, RangeName, "$") > 0 Then
                    SplitRangeName = VBA.Left(RangeName, VBA.InStr(1, RangeName, "$") - 1)
                Else
                    SplitRangeName = RangeName
                End If
                If IsNumeric(SplitRangeName) Then
                    SplitRangeName = ""
                    MsgBox "", vbInformation, ""
                End If
            Case RANGE_ALL
                SplitRangeName = "$" & RangeName
        End Select
    End If
End Function