|
Sub test()
Dim wb As Workbook
Dim ws As Worksheet
Set d = CreateObject("scripting.dictionary")
Dim MyPath$, MyName
MyPath = ThisWorkbook.Path & "\2017年\"
MyName = Dir(MyPath & "*.xls*")
With Sheets("2017")
For i = 2 To 7
d(.Cells(i, 1).Value) = i
Next
End With
Do While MyName <> ""
Set wb = GetObject(MyPath & MyName)
With wb.Sheets("水果")
r = .Cells(.Rows.Count, 1).End(3).Row
brr = .Range("B1:c" & r)
ls = Len(brr(1, 1))
ls = Left(brr(1, 1), Len(brr(1, 1)) - 1)
For j = 1 To UBound(brr)
If d.exists(brr(j, 1)) Then
With Sheets("2017")
.Cells(d(brr(j, 1)), ls + 1) = brr(j, 2)
End With
End If
Next
End With
Erase brr
wb.Close
MyName = Dir
Loop
|
|