Sub 拆分开票()
Dim arr, i, j, k, m, n
Dim hang, lie
Dim wsje_max, wsje_sum, wsje, wsje_last, sl, wsje_chae, sl_chae, dj, sl_shengyu, wsje_shengyu
Dim brr
Dim xhcs '循环次数
wsje_max = 100000
hang = Range("A1").End(xlDown).Row
arr = Range("A1:G" & hang)
lie = UBound(arr, 2)
ReDim brr(1 To 2, 1 To lie)
For m = 1 To lie
brr(1, m) = arr(1, m)
Next m
For i = 2 To UBound(arr, 1)
sl = arr(i, 3)
dj = arr(i, 7)
wsje = arr(i, 6)
wsje_sum = wsje_sum + wsje
xhcs = WorksheetFunction.RoundUp(wsje_sum / wsje_max, 0)
ReDim Preserve brr(1 To i, 1 To lie)
For m = 1 To lie
brr(i, m) = arr(i, m)
Next m
If xhcs = 2 Then
wsje_chae = wsje_max - wsje_last
sl_chae = Int(wsje_chae / dj)
brr(i, 3) = sl_chae
brr(i, 6) = wsje_chae
Range("A1").End(xlDown).Offset(3, 0).Resize(UBound(brr, 1), UBound(brr, 2)) = brr
sl_shengyu = sl - sl_chae
wsje_shengyu = wsje - wsje_chae
wsje_sum = wsje_shengyu
Else
End If
wsje_last = wsje
Next i
End Sub
拆分开票程序
于 2022-12-26 17:32:38 首次发布