|
我昨天写了一下,你看是- Sub test()
- Dim i%, k%, irow%, str$, dt
- Dim dic As Object, arr, brr, crr
- irow = Sheet2.Cells(Rows.Count, 3).End(3).Row
- dt = Sheet2.Cells(1, 3)
- str = Sheet2.Range("j2")
- arr = Sheet2.Range("a6:k" & irow).Value
- Set dic = CreateObject("scripting.dictionary")
- ReDim brr(1 To UBound(arr), 1 To 4)
- For i = 1 To UBound(arr)
- If arr(i, 10) = "" Then Exit For
- dic(UCase(arr(i, 11))) = arr(i, 10)
- k = k + 1
- brr(k, 1) = dt
- brr(k, 2) = arr(i, 3)
- brr(k, 3) = str
- brr(k, 4) = arr(i, 10)
- Next i
- irow = Sheet3.Cells(Rows.Count, 3).End(3).Row + 1
- Sheet3.Cells(irow, 3).Resize(k, 4) = brr
- irow = Sheet1.Cells(Rows.Count, "p").End(3).Row
- crr = Sheet1.Range("m5:p" & irow).Value
- For i = 1 To UBound(crr)
- If dic.exists(UCase(crr(i, 4))) Then
- crr(i, 2) = dic(UCase(crr(i, 4)))
- crr(i, 3) = dt
- End If
- Next i
- Sheet1.Range("m5").Resize(UBound(crr), 4) = crr
- End Sub
复制代码 你的需求不?我现在传不了附件,贴一下代码吧。新附件我也看不了 |
|