|
>配列に入れて一気にはき出した方が速いと思います。
DIctionaryで作ってみました。
Sub test()
Dim myDic As Object
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim NWB As Workbook
Dim r As Range
Dim i As Long
Set myDic = CreateObject("Scripting.Dictionary")
Set WB1 = Workbooks("AAA.xls")
Set WB2 = Workbooks("BBB.xls")
Set NWB = ThisWorkbook
Application.ScreenUpdating = False
With NWB.Sheets("Sheet1")
.Cells.ClearContents
.Range("A1:L1").Value = WB1.Sheets("Sheet1").Range("A1:L1").Value
End With
With WB1.Sheets("Sheet1")
For Each r In .Range(.Cells(2, "L"), .Cells(.Rows.Count, "L").End(xlUp))
If r <> "" Then
myDic(i) = r.Offset(, -11).Resize(, 12).Value
i = i + 1
End If
Next
End With
With WB2.Sheets("Sheet1")
For Each r In .Range(.Cells(2, "L"), .Cells(.Rows.Count, "L").End(xlUp))
If r <> "" Then
myDic(i) = r.Offset(, -11).Resize(, 12).Value
i = i + 1
End If
Next
End With
With NWB.Sheets("Sheet1")
.Range("A2").Resize(myDic.Count, 12).Value = Application.Transpose(Application.Transpose(myDic.Items))
.Range("A1").CurrentRegion.Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlGuess
End With
Application.ScreenUpdating = True
End Sub
|
|