|
▼(m´・ω・`)m さん:
こんにちは。
最終列の横に出力しています。
Sub TESTa()
Dim i As Long
Dim j As Long
Dim k As Long
Dim cnt As Long
Dim tol As Variant
Dim eRow As Long
Dim eCol As Long
With Worksheets("Sheet1")
eRow = .Range("A" & .Rows.Count).End(xlUp).Row
eCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
ReDim col(1 To eRow, 1 To 2)
For i = 2 To eRow
cnt = 0
For j = 2 To eCol
If WorksheetFunction.CountIf(.Columns(j), .Cells(i, 1).Value) > 0 Then
cnt = cnt + 1
Else
Exit For
End If
Next
If cnt > 0 Then
k = k + 1
col(k, 1) = .Cells(i, 1).Value
col(k, 2) = cnt + 1
End If
Next
.Cells(2, eCol + 2).Resize(k, 2).Value = col
End With
End Sub
|
|