请VBA高手帮忙，我要在EXCEL中插入一个控件，每次只要点击这个控件就能实现下面的功能

Posted 2023-03-16

我要把B列具有相同“存货编码”对应的C 列单元格合并成一个单元格，对应C列单元格与单元格之间的内容用 / 隔开，如果对应C列单元格有相同的值，只提取一个值即可（或者把对应的C列单元格的值用 / 隔开，自动复制在下面的空格中也可以）
A B C D
存货编码 需求跟踪号 可用数量
1 503210551476 ZEENX73900AB 774 1000
2 503210551476 UKV33550AB 893 2000
3 503210551476 UKV33550AB 893 150
4 503210551476 UKV33550AB 893 200
5 503210551476 汇总 3350
6 501220901007 WZC33100AB-910 200
7 501220901007 UKV33550AB 893 400
8 501220901007 汇总 600
9 511210751045 ZEENX73900AB 774 100
10 511210751045 UKV33550AB 893 250
11 511210751045 汇总 350
12 501220901007 WZC33100AB-910 200
13 501220901007 UKV33550AB 893 400
14 501220901007 汇总 600
15 总计 4900

参考技术A 先排序，最简单的就是逐行判断B列，如果本单元格内容和上一格相同，刚C列就等于上一格加上"/"再加上本列，如果不相同，就把B列内容和上面的内容写入另一个地方，最后就OK 参考技术B Option Base 1

Sub sort()
Dim r As Integer
Dim j As Integer
Dim k() As Integer
Dim tnum As String

r = [b65536].End(xlUp).Row
Set d = CreateObject("scripting.dictionary")

j = 1
For i = 3 To r
Cells(i, 2) = Trim(Cells(i, 2))
Cells(i, 3) = Trim(Cells(i, 3))

If Cells(i, 2) = Cells(i - 1, 2) Then
ReDim Preserve k(j)
k(j) = i
j = j + 1
Else
If j > 1 Then
For a = k(1) - 1 To k(j - 1)
If Not d.exists(Cells(a, 3).Text) Then
d.Add Cells(a, 3).Text, ""
tnum = tnum & "/" & Cells(a, 3).Text
End If
Next

Range("C" & k(1) - 1 & ":C" & k(j - 1)).ClearContents
Range("C" & k(1) - 1 & ":C" & k(j - 1)).Merge
Range("C" & k(1) - 1 & ":C" & k(j - 1)) = Right(tnum, Len(tnum) - 1)
tnum = ""
d.RemoveAll
End If
j = 1
End If
Next
Set d = Nothing
End Sub本回答被提问者采纳