[已解决]帮忙优化代码

A列为开票数据，由于一张开票金额不能超过117000，所以将其分割成几张。

要求1：每张金额不能超过117000

要求2：每张最后一个序号是5的倍数

雄鹰2013 · 发表于 2017-6-20 09:03

附件中有一段代码，请各位老师能否提供更简便的思路，谢谢！
Sub 测试()
Dim arr, brr
Dim s, n
Dim x As Range, y As Range
Set x = Application.InputBox("选择区域", , , , , , , 8)
Set y = Application.InputBox("存放单元格", , , , , , , 8)
arr = x
ReDim brr(1 To UBound(arr), 1 To 2)
i = 1
For i = i To UBound(arr)
   Do
   s = s + arr(i, 1)
   n = n + 1
   brr(i, 1) = n
   i = i + 1
      If i > UBound(arr) Then Exit Do
   Loop While n Mod 5 And s <= 117000
   If n Mod 5 = False And s <= 117000 Then t = s: h = i - 1
   If s > 117000 Then: brr(h, 2) = t: brr(h + 1, 1) = 1: n = 0: s = 0: i = h + 1
   i = i - 1
   If i = UBound(arr) Then brr(h + 1, 2) = s
Next i
y.Resize(, 2).ClearContents
y.Resize(UBound(arr), 2) = brr
End Sub

最佳答案

月排行榜 / 总排行榜

grf1973

2017-6-20 20:09

Sub 测试()
Dim arr, brr
Dim s, n, k
Dim x As Range, y As Range
Set x = Application.InputBox("选择区域", , , , , , , 8)
Set y = Application.InputBox("存放单元格", , , , , , , 8)
arr = x
ReDim brr(1 To UBound(arr), 1 To 2)
For i = 1 To UBound(arr)
s = s + arr(i, 1)
n = n + 1
brr(i, 1) = n
If s > 117000 Then
For k = i To i - 4 Step -1
s = s - arr(k, 1)
If k Mod 5 = 0 Then
s = s + arr(k, 1)
brr(k, 2) = s
i = k
s = 0: n = 0
Exit For
End If
Next k
End If
Next i
brr(i - 1, 2) = s
y.Resize(, 2).ClearContents
y.Resize(UBound(arr), 2) = brr
End Sub

复制代码

跳转到最佳答案楼层

grf1973 · 发表于 2017-6-20 20:09

这个最佳答案由 grf1973 给出，感谢 grf1973 的回答。

单击隐藏图章

Sub 测试()
Dim arr, brr
Dim s, n, k
Dim x As Range, y As Range
Set x = Application.InputBox("选择区域", , , , , , , 8)
Set y = Application.InputBox("存放单元格", , , , , , , 8)
arr = x
ReDim brr(1 To UBound(arr), 1 To 2)
For i = 1 To UBound(arr)
s = s + arr(i, 1)
n = n + 1
brr(i, 1) = n
If s > 117000 Then
For k = i To i - 4 Step -1
s = s - arr(k, 1)
If k Mod 5 = 0 Then
s = s + arr(k, 1)
brr(k, 2) = s
i = k
s = 0: n = 0
Exit For
End If
Next k
End If
Next i
brr(i - 1, 2) = s
y.Resize(, 2).ClearContents
y.Resize(UBound(arr), 2) = brr
End Sub

复制代码

		自动登录	找回密码
密码			注册