|
本帖最后由 Lonzo丶 于 2019-6-13 13:01 编辑
- Sub test()
- Application.ScreenUpdating = False
- Dim xlApp As Excel.Application
- Dim xlBook As Excel.Workbook
- Dim sh As Excel.Worksheet
- Dim d As Object, myr1, myr2, i, j
- Set xlApp = New Excel.Application
- Set xlBook = xlApp.Workbooks.Open("C:\Users\Jing.Zhang\Desktop\Desktop\333\6-12.xlsx") '改成你自己的路径
- Set sh = xlBook.Worksheets("Sheet2")
- Set d = CreateObject("scripting.dictionary")
- myr1 = sh.[b65535].End(3).Row
- For i = 2 To myr1
- Set d(sh.Cells(i, 2).Value) = sh.Range(sh.Cells(i, 6), sh.Cells(i, 7))
- Next
- myr2 = [b65535].End(3).Row
- For j = 2 To myr2
- If Cells(j, 2).Value <> "" Then
- If d.exists(Cells(j, 2).Value) Then
- Cells(j, 6).Resize(1, 2) = Application.Transpose(Application.Transpose(d(Cells(j, 2).Value)))
- End If
- End If
- Next
- xlBook.Close False
- Application.ScreenUpdating = True
- MsgBox "Done"
- End Sub
复制代码 |
|