请问高手一个计算个税的问题

hlgtomcat

一个个税计算的vba程序。我想让这表具有可扩展性，就是后期再往里面可以加入新的人员，可以自动计算。谢谢Sub gs()
'个税计算'
Dim i As Integer

For i = 2 To 12 Step 1
        If Range("c" & i) - 3500 <= 0 Then
    Range("d" & i) = Range("c" & i) * 0

    ElseIf Range("c" & i) - 3500 > 0 And Range("c" & i) - 3500 <= 1500 Then
    Range("d" & i) = Range("c" & i) * 0.03

    ElseIf Range("c" & i) - 3500 > 1500 And Range("c" & i) - 3500 <= 4500 Then
    Range("d" & i) = Range("c" & i) * 0.1 - 105

    ElseIf Range("c" & i) - 3500 > 4500 And Range("c" & i) - 3500 <= 9000 Then
    Range("d" & i) = Range("c" & i) * 0.2 - 555

    ElseIf Range("c" & i) - 3500 > 9000 And Range("c" & i) - 3500 <= 35000 Then
    Range("d" & i) = Range("c" & i) * 0.25 - 1005

    ElseIf Range("c" & i) - 3500 > 35000 And Range("c" & i) - 3500 <= 80000 Then
    Range("d" & i) = Range("c" & i) * 0.35 - 5505

    Else: Range("d" & i) = Range("c" & i) * 0.45 - 13505
    End If

Next
End Sub

半百

Dim i As Integer
r = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To r Step 1

shi353

'用自訂函數來查可能比較好
Sub tt1()
Set C = Range([C2], [C65000].End(3))
For i = 1 To C.Cells.Count
    With C.Cells(i)
        If Len(.Value) > 0 And Application.IsNumber(.Value) Then
            .Offset(, 2) = "=Tax1(" & .Address(0, 0) & ")"
        End If
    End With
Next
End Sub

Function Tax1(ByVal A As Integer)
    Brr = Sheet2.[H1:J8]
    If A <= 3500 Then
        Tax1 = 0
    ElseIf A < 1500 Then
        Tax1 = Brr(i, 2) * A - Brr(i, 3)
    ElseIf A - Brr(UBound(Brr), 3) > 80000 Then
        Tax1 = Brr(UBound(Brr), 2) * A - Brr(UBound(Brr), 3)
    ElseIf A >= 1500 And A <= 80000 Then
        For j = 3 To UBound(Brr) - 1
            X = Split(Brr(j, 1), "~")
            If A >= Val(X(0)) And A <= Val(X(1)) Then
                Tax1 = Brr(j, 2) * A - Brr(j, 3)
            End If
        Next
    End If
End Function

hlgtomcat

半百 发表于 2019-10-12 07:16
Dim i As Integer
r = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To r Step 1

谢谢，非常感谢。

hlgtomcat

shi353 发表于 2019-10-12 08:27
'用自訂函數來查可能比較好
Sub tt1()
Set C = Range([C2], [C65000].End(3))

打了这么多啊，谢谢高人，非常感谢。

shi353

hlgtomcat 发表于 2019-10-12 14:36
打了这么多啊，谢谢高人，非常感谢。

應該沒打多吧!  提問樓主原來的宏碼也不比我的少
不過用提問樓主宏碼執行後產生結果有些數據是跟我的宏碼執行後不一樣?
不知道是誰有誤?

lsdongjh

1. Sub gs()
   
2.     '个税计算'
   
3.     Dim lngRows As Long, lngID As Long
   
4.     Dim rgSource As Range, rgResult As Range
   
5.     Dim dblNum As Double, dblCheck As Double
   
6.    
   
7.     lngRows = Range("A" & Rows.Count).End(xlUp).Row
   
8.    
   
9.     For lngID = 2 To lngRows
   
10.         Set rgSource = Range("C" & lngID)
    
11.         Set rgResult = Range("D" & lngID)
    
12.         
    
13.         dblNum = rgSource.Value
    
14.         dblCheck = dblNum - 3500
    
15.         Select Case dblCheck
    
16.             Case Is > 80000
    
17.                 rgResult.Value = dblNum * 0.45 - 13505
    
18.             Case Is > 55000
    
19.                 rgResult.Value = dblNum * 0.35 - 5505
    
20.             Case Is > 35000
    
21.                 rgResult.Value = dblNum * 0.3 - 2755
    
22.             Case Is > 9000
    
23.                 rgResult.Value = dblNum * 0.25 - 1005
    
24.             Case Is > 4500
    
25.                 rgResult.Value = dblNum * 0.2 - 555
    
26.             Case Is > 1500
    
27.                 rgResult.Value = dblNum * 0.1 - 105
    
28.             Case Is > 0
    
29.                 rgResult.Value = dblNum * 0.03
    
30.             Case Else
    
31.                 rgResult.Value = 0
    
32.         End Select
    
33.     Next
    
34. 
    
35. End Sub

复制代码

shi353

'原來提問樓主的宏碼感覺很冗長,建議修改如下,比較簡潔
'多運用變數及With end with 替代重複物件

Sub gs11()
Dim i As Integer
r = [C65336].End(3).Row
For i = 2 To r
    X1 = Range("C" & i) - 3500
    X2 = Range("C" & i)
    With Cells(i, "d")
        If X1 <= 0 Then
            .Value = X2 * 0
        ElseIf X1 > 0 And X1 <= 1500 Then
            .Value = X2 * 0.03
        ElseIf X1 > 1500 And X1 <= 4500 Then
            .Value = X2 * 0.1 - 105
        ElseIf X1 > 4500 And X1 <= 9000 Then
            .Value = X2 * 0.2 - 555
        ElseIf X1 > 9000 And X1 <= 35000 Then
            .Value = X2 * 0.25 - 1005
        ElseIf X1 > 35000 And X1 <= 80000 Then
            .Value = X2 * 0.35 - 5505
        Else
            .Value = X2 * 0.45 - 13505
        End If
    End With
Next
End Sub

YZC51

Public Function yjgs(m, Optional n = 3500)  '个税计算
    Q = m - n
    Select Case Q
        Case Is > 80000: x = Q * 0.45 - 13505
        Case Is > 55000: x = Q * 0.35 - 5505
        Case Is > 35000: x = Q * 0.3 - 2755
        Case Is > 9000: x = Q * 0.25 - 1005
        Case Is > 4500: x = Q * 0.2 - 555
        Case Is > 1500: x = Q * 0.1 - 105
        Case Is > 0: x = Q * 0.03
        Case Else: x = 0
    End Select
    yjgs = Round(x, 2)
End Function

YZC51

Public Function yjgs(m, Optional n = 5000)  '个税计算2019按月换算
    Q = m - n
    Select Case Q
        Case Is > 80000: x = Q * 0.45 - 15160
        Case Is > 55000: x = Q * 0.35 - 7160
        Case Is > 35000: x = Q * 0.3 - 4410
        Case Is > 25000: x = Q * 0.25 - 2660
        Case Is > 12000: x = Q * 0.2 - 1410
        Case Is > 3000: x = Q * 0.1 - 210
        Case Is > 0: x = Q * 0.03
        Case Else: x = 0
    End Select
    yjgs = Round(x, 2)
End Function