|
オートフィルタを使ってみました。
セルに関数が使われているようなら、計算方法を手動にしてください。
Dim SachRag As Range, FilTRg As Range, Cel As Range, Chek As Variant
With Sheets("Sheet3")
Set SachRag = .Range(.Range("A1"), .Range("A65536").End(xlUp))
End With
With Sheets("Sheet1")
Set FilTRg = .Range(.Range("A1"), .Range("A65536").End(xlUp))
End With
Application.ScreenUpdating = False
For Each Cel In SachRag
Chek = Application.Match(Cel.Value, FilTRg, 0)
If Not IsError(Chek) Then
FilTRg.AutoFilter Field:=1, Criteria1:=Cel.Value
FilTRg.Offset(1).Resize(FilTRg.Count - 1).SpecialCells(xlCellTypeVisible).Copy
Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
Sheets("Sheet1").ShowAllData
DoEvents
End If
Next
Sheets("Sheet1").AutoFilterMode = False
Application.ScreenUpdating = True
|
|