| |
こんにちは
お試しを。
尚、１行目は項目行であること。
Sub Test_1()
Dim Ws As Worksheet, Da As Variant, R As Range, C As Range
Dim Myma As Variant, Myma1 As Variant, Co As Long, i As Long
Set Ws = Worksheets("総合")
With Worksheets("A")
With .Range("A1", .Range("A65536").End(xlUp))
Da = .Value
.AdvancedFilter xlFilterCopy, , Worksheets("A").Range("IV1"), True
End With
Set R = .Range("IV2", .Range("IV65536").End(xlUp))
For Each C In R
Myma = Application.Match(C.Value, .Columns(1), 0)
If Not IsError(Myma) Then
Myma1 = Application.Match(.Cells(Myma, 2).Value, Ws.Columns(3), 0)
If Not IsError(Myma1) Then
Co = 0
For i = Myma To UBound(Da)
If Da(i, 1) <> C.Value Then
Exit For
End If
Co = Co + 1
Next i
.Cells(Myma + 1, 2).Resize(Co-1).Copy Ws.Cells(Myma1 + 1, 3)
End If
End If
Next C
.Columns(256).Clear
End With
Set R = Nothing: Set Ws = Nothing
End Sub
|
|
Statis
- 06/6/8(木) 9:27 -
