Option Explicit
Sub test()
Dim arr, i, j, k, t, brr, cnt
With Sheets("目标")
arr = .Range("b3:e" & .Cells(Rows.Count, "b").End(xlUp).Row)
End With
With Sheets("BOM")
brr = .[a1].CurrentRegion
ReDim crr(1 To Rows.Count, 1 To 5)
For i = 1 To UBound(arr, 1)
t = arr(i, 1) & arr(i, 2) & arr(i, 3)
For j = 1 To UBound(brr, 1)
If t = brr(j, 1) & brr(j, 2) & brr(j, 3) Then
cnt = cnt + 1
For k = 1 To UBound(crr, 2) - 1
crr(cnt, k) = brr(j, k + 3)
Next
crr(cnt, k) = arr(i, 4)
Call dfs(arr, brr, crr, brr(j, 4), cnt, i)
End If
Next j, i
With .[j2] '输出位置,自己修改
.Resize(Rows.Count - 1, UBound(crr, 2)).ClearContents
.Resize(cnt, UBound(crr, 2)) = crr
End With
End With
End Sub
Function dfs(arr, brr, crr, s, cnt, pos)
Dim i, j
For i = 2 To UBound(brr, 1)
If s = brr(i, 1) Then
cnt = cnt + 1
For j = 1 To UBound(crr, 2) - 1
crr(cnt, j) = brr(i, j + 3)
Next
crr(cnt, j) = arr(pos, 4)
Call dfs(arr, brr, crr, brr(i, 4), cnt, pos)
End If
Next
End Function |