|
▼ichinose さん:
自分なりに頑張ってみましたが、うまく動きません。
A列 B列とカウントしたいときがあり、このように変えてみました。
っがうまく動きません。どのようにしたら、よろしいでしょうか?
また、今後、C列も増える予定に変更され、AとB列の組合せだけでなく
BとC列の組み合わせもありえるとのことで、変更箇所等を教えてください。
Sub A列()
抽出 "A"
End Sub
Sub B列()
抽出 "B"
End Sub
Sub 抽出(RowNo As String)
Set rng = Range("" & RowNo & "2:" & RowNo & "" & Cells(Rows.Count, 1).End(xlUp).Row & "")
If rng.Row > 1 Then
Set dic = CreateObject("scripting.dictionary")
With dic
For Each crng In rng
If .Exists(CStr(crng.Value)) Then .Item(CStr(crng.Value)) = .Item(CStr(crng.Value)) + 1
Else
.Add CStr(crng.Value), 1
End If
Next
Cells(rng.Count + 2, RowNo).Value = Cells(1, RowNo).Value
Range(Cells(rng.Count + 3, RowNo), Cells(rng.Count + 2 + .Count, RowNo)).Value = Application.Transpose(.Keys)
Range(Cells(rng.Count + 3, RowNo), Cells(rng.Count + 2 + .Count, 2)).Value = Application.Transpose(.Items)
Range(Cells(rng.Count + 3, RowNo), Cells(rng.Count + 3 + .Count, 2)).Sort Key1:=Cells(rng.Count + 3, 1), Order1:=xlAscending, Header:=xlNo
End With
Set dic = Nothing
End If
End Sub
|
|