|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Option Explicit
Sub TEST()
Dim ar, br, cr, i&, j&, m&, n&
Application.ScreenUpdating = False
br = Sheets(2).[A1].CurrentRegion
cr = Array(2, 10, 6, 7)
With [A1].CurrentRegion
.Offset(1, 1).ClearContents
ar = .Value
For i = 2 To UBound(ar)
For j = 2 To UBound(br)
If br(j, 1) = ar(i, 1) Then
For m = j + 1 To UBound(br)
If br(m, 1) = "" Then
For n = 0 To UBound(cr)
If ar(i, n + 2) = "" Then
ar(i, n + 2) = br(m, cr(n))
Else
ar(i, n + 2) = ar(i, n + 2) & "、" & br(m, cr(n))
End If
Next n
Else
Exit For
End If
Next m
Exit For
End If
Next j
Next i
.Value = ar
End With
Application.ScreenUpdating = True
Beep
End Sub
|
评分
-
1
查看全部评分
-
|