|
- Sub 字典法()
- Dim d As Object, d1 As Object, d2 As Object, d3 As Object
- Dim arr, brr, i As Integer, j As Integer
- Set d = CreateObject("scripting.dictionary")
- Set d1 = CreateObject("scripting.dictionary")
- Set d2 = CreateObject("scripting.dictionary")
- Set d3 = CreateObject("scripting.dictionary")
- arr = Sheet2.Range("b3:f49")
- brr = Sheet1.Range("a3:a15")
- For i = 1 To UBound(brr)
- d(brr(i, 1)) = ""
- Next i
- Dim srr
- srr = d.keys
- For i = 1 To UBound(arr)
- For j = 0 To UBound(srr)
- If arr(i, 1) = srr(j) Then
- d1(arr(i, 1)) = arr(i, 2)
- d2(arr(i, 1)) = arr(i, 4)
- d3(arr(i, 1)) = arr(i, 5)
- Exit For
- End If
- Next j
- Next i
- For i = 1 To UBound(brr)
- Cells(i + 2, "b") = d1(brr(i, 1))
- Cells(i + 2, "c") = d2(brr(i, 1))
- Cells(i + 2, "e") = d3(brr(i, 1))
- Next i
- Set d1 = Nothing
- Set d2 = Nothing
- Set d3 = Nothing
- End Sub
复制代码 字典法如上,是不是要这样?
|
|