Excel VBA银行发放超过1W元的数据拆分

【问题】今天有人问：银行发放时，有数据超过1万元的时候不能一次发放，只能分两次，

例如：

650，要不用拆分，就一笔

12000，要拆分成二笔：10000，2000

23000，要拆分成10000，10000，3000三笔。

【解决】

如果数据少，可以手工完成，如果数据量有几万条，那拆分就要加班啦。

如图：

将会拆分成如下

【代码】

代码语言：javascript复制

Sub 银行发放超过1W的拆分()
    Dim sp_arr(), arr, brr()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    arr = [a1].CurrentRegion
    Range("k2").Resize(10000, 4).ClearContents
    For i = 2 To UBound(arr)
        money = Val(arr(i, 4))
        sp_n = Int(money / 10000)
        If sp_n < 1 Then
            sp_n = 0
        Else
            If sp_n = money / 10000 Then
                sp_n = sp_n - 1
            End If
        End If
    
        ReDim sp_arr(sp_n)
        For j = 0 To sp_n
            If j = sp_n Then
                sp_arr(j) = money - sp_n * 10000
            Else
                sp_arr(j) = 10000
            End If
            Debug.Print sp_n, sp_arr(j)
            dic(dic.Count   1) = Array(arr(i, 1), arr(i, 2), arr(i, 3), sp_arr(j))
        Next j
    Next i
    temparr = Application.Transpose(Application.Transpose(dic.items))
    Range("k2").Resize(UBound(temparr, 1), UBound(temparr, 2)) = temparr
End Sub

Sub 银行发放超过1W的拆分()

Dim sp_arr(), arr, brr()

Dim dic As Object

Set dic = CreateObject("Scripting.Dictionary")

arr = [a1].CurrentRegion

Range("k2").Resize(10000, 4).ClearContents

For i = 2 To UBound(arr)

money = Val(arr(i, 4))

sp_n = Int(money / 10000)

If sp_n < 1 Then

sp_n = 0

Else

If sp_n = money / 10000 Then

sp_n = sp_n - 1

End If

End If

ReDim sp_arr(sp_n)

For j = 0 To sp_n

If j = sp_n Then

sp_arr(j) = money - sp_n * 10000

Else

sp_arr(j) = 10000

End If

Debug.Print sp_n, sp_arr(j)

dic(dic.Count 1) = Array(arr(i, 1), arr(i, 2), arr(i, 3), sp_arr(j))

Next j

Next i

temparr = Application.Transpose(Application.Transpose(dic.items))

Range("k2").Resize(UBound(temparr, 1), UBound(temparr, 2)) = temparr

End Sub

jquery

0 人点赞