VBA自定义函数集锦

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

2、作用说明：
相当于VLOOKUP吧，查询某一值第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

3、

求个人所得税Grsds(bsc,mysala)

该函数返回一个个人工资薪金所得应纳个人所得税税额。

语法：Grsds(bsc,mysala)
其中：
bsc,必选项，为起征点，包括税法规定的工资基数800元加上允许税前扣除的合理费用；
mysala,必选项，为人个工资薪金所得。

示例：
Grsds(850,20000)=3455.00
返回当个人工资薪金所得为2000元(起征点为850元)时的应纳个人所得税税额。

求个人所得税Grsds(bsc,mysala)

该函数返回一个个人工资薪金所得应纳个人所得税税额。

语法：Grsds(bsc,mysala)
其中：
bsc,必选项，为起征点，包括税法规定的工资基数800元加上允许税前扣除的合理费用；
mysala,必选项，为人个工资薪金所得。

示例：
Grsds(850,20000)=3455.00
返回当个人工资薪金所得为2000元(起征点为850元)时的应纳个人所得税税额。

Function Grsds()Function Grsds(bsc As Double, mysala As Double) As Double

'bsc为起征点加上允许税前扣除的合理费用,mysala为工资薪金所得

'author：tanjh

On Error GoTo Grsds_err

Select Case mysala

Case Is <= bsc

Grsds = 0

Case Is <= bsc+500

Grsds = Application.WorksheetFunction.Round((mysala - bsc) * 0.05, 2)

Case Is <= bsc+2000

Grsds = Application.WorksheetFunction.Round((mysala - bsc) * 0.1 - 25, 2)

Case Is <= bsc+5000

Grsds = Application.WorksheetFunction.Round((mysala - bsc) * 0.15 - 125, 2)

Case Is <= bsc+20000

Grsds = Application.WorksheetFunction.Round((mysala - bsc) * 0.2 - 375, 2)

Case Is <= bsc+40000

Grsds = Application.WorksheetFunction.Round((mysala - bsc) * 0.25 - 1375, 2)

Case Is <= bsc+60000

Grsds = Application.WorksheetFunction.Round((mysala - bsc) * 0.3 - 3375, 2)

Case Is <= bsc+80000

Grsds = Application.WorksheetFunction.Round((mysala - bsc) * 0.35 - 6375, 2)

Case Is <= bsc+100000

Grsds = Application.WorksheetFunction.Round((mysala - bsc) * 0.4 - 10375, 2)

Case Else

Grsds = Application.WorksheetFunction.Round((mysala - bsc) * 0.45 - 15375, 2)

End Select

Grsds_Exit:

Exit Function

Grsds_err:

MsgBox Err.Number & ':' & Err.Description

Resume Grsds_Exit

End Function

4、金额数字转中文大写，财务人员必备

Function Money(Number As Currency)
Dim i, j, k, m, leng           As Integer         '计数器
Dim Zero                       As Integer         '连续零标识
Dim Tnumber                    As String          '储存数字字符串,计算数组长度
Dim Num()                      As String          '定义数组
Dim Num1(3)                    As String          '存储万元以下数字
Dim Num2(1)                    As String          '储存拆分后的数字
Dim Cha(8), Cha1(9), Cha2(4)   As String          '储存转化后的汉字
Dim Zcha                       As String          '连接后的字符串
Dim Flag, Flag1                As Boolean         '正负标志
Flag = True
Flag1 = False
Zero = 0
'*******如果大于一亿，则不处理*********
If (Number > 99999999) Or (Number < -99999999) Then
MsgBox ('Sorry,数据超过一亿，暂不处理。')
MsgBox ('顺便问一下，你真有那么多钱吗？')
Money = 'Sorry!'
Else
If (Number = 0) Then
Money = '零元整'
Else
'*******将负数数字转化正数并更改标识*************
If (Number < 0) Then
   Number = Number * (-1)
   Flag = False
End If
'*******小数点后超过两位，则截断******
If (((Number - Int(Number)) * 100 - Int((Number - Int(Number)) * 100)) > 0) Then
   Tnumber = CStr(Int(Number * 100) / 100)
Else
   Tnumber = CStr(Number)
End If
'*******处理四舍五入*******************
If (((Number - Int(Number)) * 100 - Int((Number - Int(Number)) * 100)) >= 0.5) Then
   Tnumber = CStr((CCur(Tnumber)) + 0.01)
End If
Number = CCur(Tnumber)
'*******重新分配数组空间***************
ReDim Num(Len(Tnumber) - 1) As String
'*******将字符串分开存储至数组中*******
For i = 0 To Len(Tnumber) - 1
   Num(i) = Mid(Tnumber, i + 1, 1)
Next i
'*******定义所需字符*******************
Dim M1, M2
M1 = Array('零', '壹', '贰', '叁', '肆', '伍', '陆', '柒', '捌', '玖')
M2 = Array('', '拾', '佰', '仟', '万', '亿')
'*******处理小于一元金额***************
'*******小数点后一位，则***************
If ((Number - Int(Number) > 0) And ((Number * 100 - Int(Number) * 100) Mod 10) = 0) Then
       i = i - 1
       Num2(0) = Num(i)
       Num(i) = ''
       i = i - 1
       Num(i) = ''
       i = i - 1
       Cha2(0) = M1(CByte(Num2(0)))
       Cha2(1) = '角'
       Cha2(2) = '整'
    Else
'*******小数点后两位则*****************
       If ((Number - Int(Number) > 0)) Then
          i = i - 1
          Num2(1) = Num(i)
          Num2(0) = Num(i - 1)
          Num(i) = ''
          i = i - 1
          Num(i) = ''
          i = i - 1
          Num(i) = ''
          i = i - 1
          Cha2(0) = M1(CByte(Num2(0)))
          Cha2(1) = '角'
          Cha2(2) = M1(CByte(Num2(1)))
          Cha2(3) = '分'
       End If
    End If
'********分解大于一万的整数部分******************
    If (Int(Number) > 9999) Then
       If (Cha2(0) <> '') Then
          i = i + 1
       End If
       For j = 3 To 0 Step -1
          Num1(j) = Num(i - 1)
          Num(i - 1) = ''
          i = i - 1
       Next j
    Else
       If (Cha2(0) <> '') Then
          i = i + 1
       End If
       For j = 0 To i - 1
          Num1(j) = Num(j)
          Num(j) = ''
       Next j
    End If
'*******转换万元以上数字**********************************
If (Num(0) <> '') Then
    leng = i
    j = 0
    For k = 0 To leng - 1
      If (Num(k) = '0') Then
         Zero = Zero + 1
         For m = 1 To 5
            If (Cha(j - 1) = M2(m)) Then
               Flag1 = True
            End If
         Next m
         If ((Zero = 1) And (Flag1 = False)) Then
            Cha(j) = M1(CByte(Num(k)))
         End If
         If (Zero = 1) Then
            j = j + 1
         End If
      Else
         If (Num(k) <> '') Then
            If (Zero > 0) Then
               Cha(j - 1) = '零'
            End If
            Cha(j) = M1(CByte(Num(k)))
         End If
         j = j + 1
      End If
      If (Num(k) = '0') Then
         i = i - 1
      Else
         Cha(j) = M2(i - 1)
         j = j + 1
         i = i - 1
         Zero = 0
      End If
    Next k
    Cha(j - 1) = '万'
    Zero = 0
  End If
'*******转换万元以下数字**********************************
  If (Num1(0) <> '') Then
    j = 0
    Flag1 = False
    leng = 3
    While (Num1(leng) = '')
       leng = leng - 1
    Wend
    i = leng + 1
    For k = 0 To leng
     If (Num1(k) <> '') Then
      If (Num1(k) = '0') Then
         Zero = Zero + 1
         For m = 1 To 5
           If (j <> 0) Then
            If (Cha1(j - 1) = M2(m)) Then
               Flag1 = True
            End If
           End If
         Next m
         If ((Zero = 1) And (Flag1 = False)) Then
            Cha1(j) = M1(CByte(Num1(k)))
         End If
         If (Zero = 1) Then
            j = j + 1
         End If
      Else
         If (Num1(k) <> '') Then
            If (Zero > 0) Then
               Cha1(j - 1) = '零'
            End If
            Cha1(j) = M1(CByte(Num1(k)))
         End If
         j = j + 1
      End If
      If (Num1(k) = '0') Then
         i = i - 1
      Else
         Cha1(j) = M2(i - 1)
         j = j + 1
         i = i - 1
         Zero = 0
      End If
     End If
    Next k
    Cha1(j - 1) = '元'
    If (Cha2(0) = '') Then
       Cha1(j) = '整'
    End If
  End If
'*******连接字符串*********************
  j = 0
  While (Cha(j) <> '')
     Zcha = Zcha & Cha(j)
     j = j + 1
  Wend
  j = 0
  While (Cha1(j) <> '')
     Zcha = Zcha & Cha1(j)
     j = j + 1
  Wend
  j = 0
  While (Cha2(j) <> '')
     Zcha = Zcha & Cha2(j)
     j = j + 1
  Wend
'*******最终显示***********************
   If (Flag) Then
     Money = Zcha
   Else
     Money = '负' & Zcha
   End If
  End If
End If
End Function