求助各位老师

xjkxjk000

liulang0808 发表于 2019-9-7 15:46
把附件上传看看吧

好的老师。

liulang0808

xjkxjk000 发表于 2019-9-7 15:50
好的老师。

结果是放在K列及以后，没有楼主说的0的情况啊

月关

原来是同一个地址最后只剩一条的时候直接跳过了，但是却沿用了跳过前的数据。
下班有事，有点匆忙，改了一下，你再试试。我撇了一眼你原来的 单行公斤数总和，没问题了。

1. Sub test()
   
2. arr = [a1].CurrentRegion.Resize(, 3).Offset(1)
   
3. ReDim brr(1 To UBound(arr), 1 To 3)
   
4. For i = 1 To UBound(arr) - 1
   
5. Do While arr(i + n + 1, 2) = arr(i, 2)
   
6. x = x + arr(i + n + 1, 3): y = arr(i, 3) + x
   
7. If y > 35 Then y = y - arr(i + n + 1, 3): Exit Do
   
8. n = n + 1
   
9. Loop
   
10. k = k + 1: m = m + 1
    
11. If n = 0 Then
    
12. brr(m, 1) = arr(i, 1) & "-" & k: brr(m, 2) = arr(i, 2): brr(m, 3) = arr(i, 3)
    
13. Else
    
14. brr(m, 1) = arr(i, 1) & "-" & k: brr(m, 2) = arr(i, 2): brr(m, 3) = y
    
15. End If
    
16. If Not arr(i + n + 1, 2) = arr(i, 2) Then k = 0
    
17. i = i + n: n = 0: x = 0
    
18. Next
    
19. [k1].Resize(UBound(brr), 3) = brr
    
20. End Sub

复制代码

月关

liulang0808 发表于 2019-9-7 16:03
结果是放在K列及以后，没有楼主说的0的情况啊

确实是有问题，Sum 一下就知道了

月关

xjkxjk000 发表于 2019-9-7 15:50
好的老师。

我的数据也是放到K列了，你直接改最后一行的 单元格地址就行。
如[k1] 改成 [d1]

xjkxjk000

liulang0808 发表于 2019-9-7 16:03
结果是放在K列及以后，没有楼主说的0的情况啊

我修改了下代码，0那个没事情了，就是图片里的功能想问下可不可以实现？

xjkxjk000

月关 发表于 2019-9-7 17:00
我的数据也是放到K列了，你直接改最后一行的 单元格地址就行。
如[k1] 改成 [d1]

谢谢老师，问下楼下的功能可以实现吗？

liulang0808

1. Sub 按钮1_Click()
   
2.     Application.ScreenUpdating = False
   
3.     r = Cells(Rows.Count, 1).End(3).Row
   
4.     arr = [a1].Resize(r + 1, 4)
   
5.     sm = arr(2, 3)
   
6.     x = 0
   
7.     r = 1
   
8.     y = 1
   
9.     For j = 2 To UBound(arr) - 1
   
10.         If arr(j, 1) <> arr(j + 1, 1) Then
    
11.             r = r + 1
    
12.             x = x + 1
    
13.             arr(r, 2) = arr(j, 2)
    
14.             arr(r, 1) = arr(j, 1) & "-" & x
    
15.             arr(r, 3) = sm
    
16.             arr(r, 4) = y
    
17.             sm = arr(j + 1, 3)
    
18.             x = 0
    
19.             y = 1
    
20.         Else
    
21.             If sm + arr(j + 1, 3) > 35 Then
    
22.                 r = r + 1
    
23.                 x = x + 1
    
24.                 arr(r, 2) = arr(j, 2)
    
25.                 arr(r, 1) = arr(j, 1) & "-" & x
    
26.                 arr(r, 3) = sm
    
27.                 arr(r, 4) = y
    
28.                 sm = arr(j + 1, 3)
    
29.                 y = 1
    
30.             Else
    
31.                 sm = sm + arr(j + 1, 3)
    
32.                 y = y + 1
    
33.             End If
    
34.         End If
    
35.     Next j
    
36.     arr(1, 3) = "公斤数"
    
37.     [k1].Resize(r, UBound(arr, 2)) = arr
    
38.     Application.ScreenUpdating = True
    
39. End Sub
    

复制代码

liulang0808

看看是不是这个意思吧

xjkxjk000

liulang0808 发表于 2019-9-7 17:25

嗯嗯，是的谢谢老师！