[已解决]求助：各位大神帮忙，用VBA如何将同一运单号的内容合并

123123学习

运单号	商品名称	数量	单位
866225411224413	A2 奶粉 1段 900G	1	罐
866225411224413	A2 奶粉 3段 900G	1	罐
866225411224413	BBOX 吸管杯 6+ (紫色)	1	个
866225411224413	bioisland 婴幼儿 （儿童）乳钙 90粒	1	瓶
866652144774312	bioisland 婴幼儿（儿童）鱼油 90粒	1	瓶
866652144774312	bioisland 孕妇 DHA 60粒	1	瓶
866652144774312	blackmores 冰冰霜 50G	1	瓶
866624771113664	goat 羊奶皂 粉色（椰子味） 100g	1	个
				要求：将同一运单号的内容合并（商品名称*数量单位）
运单号	商品名称	数量	单位	效果：
866225411224413	A2 奶粉 1段 900G	1	罐	A2 奶粉 1段 900G*1罐；A2 奶粉 3段 900G*1罐；BBOX 吸管杯 6+ (紫色)*1个；bioisland 婴幼儿 （儿童）乳钙 90粒*1瓶；
866225411224413	A2 奶粉 3段 900G	1	罐
866225411224413	BBOX 吸管杯 6+ (紫色)	1	个
866225411224413	bioisland 婴幼儿 （儿童）乳钙 90粒	1	瓶
866652144774312	bioisland 婴幼儿（儿童）鱼油 90粒	1	瓶	bioisland 婴幼儿（儿童）鱼油 90粒*1瓶；bioisland 孕妇 DHA 60粒*1瓶；blackmores 冰冰霜 50G*1瓶；
866652144774312	bioisland 孕妇 DHA 60粒	1	瓶
866652144774312	blackmores 冰冰霜 50G	1	瓶
866624771113664	goat 羊奶皂 粉色（椰子味） 100g	1	个	goat 羊奶皂 粉色（椰子味） 100g*1个；

最佳答案

月排行榜 / 总排行榜

wc110wc110

2017-9-8 18:41

你的表从g列开始的，所以以后的运单数据必须从g2开始。

我整成了这种模式，m列 提取重复的运单号，n列是买的物品。运单号中间不能断行，而且我先把你的原始数据按照运单号从小到大排序。第39行代码我发现错了，最开始是 s1=0，这样导致每个合并的运单号开头多了各0， 我改成了s1=""后，就正确了。
求助：如何将同一运单号的内容合并444.zip (18.51 KB, 下载次数: 10)

2017-9-11 09:24 上传

点击文件名下载附件


代码如下：

1. Sub ceshi()
   
2.     Dim i As Long, j As Long, i1 As Long, j1 As Long, arr As Variant, szh As Long, szl As Long
   
3.     Dim sl As String, tt As Long
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     szh = Range("g2").CurrentRegion.Rows.Count
   
7.     szl = Range("g2").CurrentRegion.Columns.Count
   
8.     arr = Range(Cells(2, "g"), Cells(szh, szl))
   
9.     Range(Cells(2, "g"), Cells(szh, szl)).Select
   
10.     ActiveSheet.Sort.SortFields.Clear
    
11.     ActiveSheet.Sort.SortFields.Add Key:=Range(Cells(2, "g"), Cells(szh, "g")), _
    
12.         SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
13.     With ActiveSheet.Sort
    
14.         .SetRange Range(Cells(2, "g"), Cells(szh, szl))
    
15.         .Header = xlGuess
    
16.         .MatchCase = False
    
17.         .Orientation = xlTopToBottom
    
18.         .SortMethod = xlPinYin
    
19.         .Apply
    
20.     End With
    
21.     i = 2
    
22.     j = i + 1
    
23.     i1 = 2
    
24.     Do
    
25.         If Cells(i, "g") = "" Then
    
26.             Exit Do
    
27.         End If
    
28.         Do
    
29.             If Cells(j, "g") = "" Then
    
30.                 Exit Do
    
31.             End If
    
32.             If Cells(i, "g") = Cells(j, "g") Then
    
33.                 j = j + 1
    
34.             Else
    
35.                 Exit Do
    
36.             End If
    
37.         Loop
    
38.         Cells(i1, "m") = Cells(i, "g")
    
39.         sl = ""
    
40.         For tt = i To j - 1
    
41.             sl = sl & Cells(tt, "i") & "*" & Cells(tt, "j") & Cells(tt, "k") & ";"
    
42.         Next
    
43.         Cells(i1, "n") = sl
    
44.         i = j
    
45.         j = i + 1
    
46.         i1 = i1 + 1
    
47.     Loop
    
48.     Application.ScreenUpdating = True
    
49.     Application.DisplayAlerts = True
    
50. End Sub
    

复制代码

跳转到最佳答案楼层

QCW911

找下字典，应该可以解决

wc110wc110

你的表从g列开始的，所以以后的运单数据必须从g2开始。

我整成了这种模式，m列 提取重复的运单号，n列是买的物品。运单号中间不能断行，而且我先把你的原始数据按照运单号从小到大排序。第39行代码我发现错了，最开始是 s1=0，这样导致每个合并的运单号开头多了各0， 我改成了s1=""后，就正确了。
求助：如何将同一运单号的内容合并444.zip (18.51 KB, 下载次数: 10)

2017-9-11 09:24 上传

点击文件名下载附件


代码如下：

1. Sub ceshi()
   
2.     Dim i As Long, j As Long, i1 As Long, j1 As Long, arr As Variant, szh As Long, szl As Long
   
3.     Dim sl As String, tt As Long
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     szh = Range("g2").CurrentRegion.Rows.Count
   
7.     szl = Range("g2").CurrentRegion.Columns.Count
   
8.     arr = Range(Cells(2, "g"), Cells(szh, szl))
   
9.     Range(Cells(2, "g"), Cells(szh, szl)).Select
   
10.     ActiveSheet.Sort.SortFields.Clear
    
11.     ActiveSheet.Sort.SortFields.Add Key:=Range(Cells(2, "g"), Cells(szh, "g")), _
    
12.         SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
13.     With ActiveSheet.Sort
    
14.         .SetRange Range(Cells(2, "g"), Cells(szh, szl))
    
15.         .Header = xlGuess
    
16.         .MatchCase = False
    
17.         .Orientation = xlTopToBottom
    
18.         .SortMethod = xlPinYin
    
19.         .Apply
    
20.     End With
    
21.     i = 2
    
22.     j = i + 1
    
23.     i1 = 2
    
24.     Do
    
25.         If Cells(i, "g") = "" Then
    
26.             Exit Do
    
27.         End If
    
28.         Do
    
29.             If Cells(j, "g") = "" Then
    
30.                 Exit Do
    
31.             End If
    
32.             If Cells(i, "g") = Cells(j, "g") Then
    
33.                 j = j + 1
    
34.             Else
    
35.                 Exit Do
    
36.             End If
    
37.         Loop
    
38.         Cells(i1, "m") = Cells(i, "g")
    
39.         sl = ""
    
40.         For tt = i To j - 1
    
41.             sl = sl & Cells(tt, "i") & "*" & Cells(tt, "j") & Cells(tt, "k") & ";"
    
42.         Next
    
43.         Cells(i1, "n") = sl
    
44.         i = j
    
45.         j = i + 1
    
46.         i1 = i1 + 1
    
47.     Loop
    
48.     Application.ScreenUpdating = True
    
49.     Application.DisplayAlerts = True
    
50. End Sub
    

复制代码

123123学习

非常感谢！

123123学习

[em17]

123123学习

收到，谢谢老师！