|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
将相同料号对应的机种信息做累加,执行过程中只能执行一部分。
资料如附件。从料号 0613-015G0IN之后相同料号的机种就不合并了。想了好久不知道哪里有问题。请帮忙看下。
Sub エ栋5()
On Error Resume Next
Dim q8&, q9&, q10&, q11&, m&, n&
arr = Range("a1").CurrentRegion
Dim brr()
ReDim brr(1 To UBound(arr), 1 To 3)
brr(1, 1) = arr(1, 1)
brr(1, 2) = arr(1, 2)
brr(1, 3) = arr(1, 3)
Dim crr()
ReDim crr(1 To UBound(arr))
For q10 = 2 To UBound(arr)
crr = WorksheetFunction.Index(brr, 0, 1)
crr = WorksheetFunction.Transpose(crr)
q11 = 0
q11 = Application.WorksheetFunction.Match(arr(q10, 1), crr, 0)
If q11 = "0" Then
n = n + 1
brr(n, 1) = arr(q10, 1)
brr(n, 2) = arr(q10, 2)
brr(n, 3) = arr(q10, 3)
Else
brr(n, 2) = brr(n, 2) & "/" & arr(q10, 2)
End If
Next q10
[G1].Resize(UBound(brr), 3) = brr
End Sub
|
|