- Sub Macro1()
- Dim arr, brr, crr, d, i&, j%, k%, s&
- Set d = CreateObject("scripting.dictionary")
- ReDim arr(1 To 60000, 1 To 12)
- brr = Sheet2.Range("a1").CurrentRegion
- crr = Sheet3.Range("a1").CurrentRegion
- For i = 2 To UBound(crr)
- d(crr(i, 1)) = d(crr(i, 1)) & " " & i
- Next
- For i = 2 To UBound(brr)
- If d.Exists(brr(i, 1)) Then
- x = Split(Mid(d(brr(i, 1)), 2))
- For j = 0 To UBound(x)
- s = s + 1
- For k = 1 To 4
- arr(s, k) = crr(x(j), k)
- Next
- arr(s, 5) = crr(x(j), 6)
- arr(s, 6) = crr(x(j), 5)
- For k = 3 To 6
- arr(s, k + 4) = brr(i, k)
- Next
- arr(s, 11) = arr(s, 6) * arr(s, 7)
- arr(s, 12) = brr(i, 7)
- Next
- End If
- Next
- Sheet1.Range("a2").Resize(s, 12) = arr
- End Sub
复制代码 |