|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Sub test()
- Dim d, arr, brr, wb As Workbook
- Set d = CreateObject("scripting.dictionary")
- Set d1 = CreateObject("scripting.dictionary")
- arr = Sheet1.Range("a7:g" & Sheet1.[a65536].End(3).Row)
- t = ThisWorkbook.Path & "\数据库.xls"
- Set wb = Workbooks.Open(t)
- With wb.Worksheets(1)
- r = .Range("a65536").End(xlUp).Row
- brr = .Range("a2:f" & r)
- For i = 1 To UBound(brr)
- d(brr(i, 1)) = Array(brr(i, 2), brr(i, 3), brr(i, 4), brr(i, 5), brr(i, 6))
- Next
- End With
- ActiveWorkbook.Saved = True
- ActiveWorkbook.Close
- t = ThisWorkbook.Path & "\11.xls"
- Set wb = Workbooks.Open(t)
- With wb.Worksheets(1)
- r = .Range("a65536").End(xlUp).Row
- crr = .Range("a2:e" & r)
- For i = 1 To UBound(crr)
- d1(crr(i, 2)) = crr(i, 5)
- Next
- End With
- ActiveWorkbook.Saved = True
- ActiveWorkbook.Close
- For k = 1 To UBound(arr)
- arr(k, 2) = d(arr(k, 1))(0)
- arr(k, 3) = d(arr(k, 1))(1)
- arr(k, 4) = d(arr(k, 1))(2)
- arr(k, 5) = d(arr(k, 1))(3)
- arr(k, 6) = d(arr(k, 1))(4)
- arr(k, 7) = d1(arr(k, 1))
- Next
- Sheet1.[a7].Resize(UBound(arr), 7) = arr
- End Sub
复制代码 字典作业
|
评分
-
1
查看全部评分
-
|