- Sub test()
- Dim i&, j&, arr, brr, crr()
- arr = Cells(7, 2).Resize(Cells(Rows.Count, 2).End(3).Row - 6, 3)
- brr = Cells(7, 5).Resize(Cells(Rows.Count, 5).End(3).Row - 6, 1)
- For i = 1 To UBound(brr)
- For j = 1 To UBound(arr)
- If arr(j, 3) = brr(i, 1) Then
- n = n + 1
- ReDim Preserve crr(1 To 2, 1 To n)
- crr(1, n) = brr(i, 1)
- crr(2, n) = Format(arr(j, 1), "000")
- End If
- Next
- Next
- Columns("h:h").NumberFormat = "@"
- Cells(7, "g").Resize(UBound(crr, 2), 2) = Application.Transpose(crr)
- End Sub
复制代码 |