求助各位老师

xjkxjk000

地址相同的，根据单行公斤数从上往下汇总公斤数，且汇总公斤数最大不能超过35公斤，如左侧标黄处的汇总公斤数的逻辑，然后再达成上面的效果可以实现吗

xjkxjk000

原始数据只有单号，地址，和单行公斤数

卢嘉轩

xjkxjk000 发表于 2019-9-7 00:41
原始数据只有单号，地址，和单行公斤数

有点懂你的意思，如果在大于35就少汇总一个单元格。

deadzlq

PQ参考解法

liulang0808

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

复制代码

liulang0808

F附件内容供参考。。。。。。

xjkxjk000

deadzlq 发表于 2019-9-7 08:19
PQ参考解法

这个太高深了看不懂啊老师。。。

xjkxjk000

liulang0808 发表于 2019-9-7 08:26
F附件内容供参考。。。。。。

老师，这个为什么都是-0呢

liulang0808

xjkxjk000 发表于 2019-9-7 11:55
老师，这个为什么都是-0呢

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

复制代码

不好意思，变量x忘记修改了

xjkxjk000

liulang0808 发表于 2019-9-7 12:07
不好意思，变量x忘记修改了

数据多一点就会出错是怎么回事啊老师