| |
▼hatena さん：
こんばんは。
>自分なりに頑張ってみましたが、うまく動きません。
>A列 B列とカウントしたいときがあり、このように変えてみました。
>っがうまく動きません。どのようにしたら、よろしいでしょうか？
>また、今後、C列も増える予定に変更され、AとB列の組合せだけでなく
>BとC列の組み合わせもありえるとのことで、変更箇所等を教えてください。
なるほど・・・、サブプロシジャーにするのは賛成です。
でも、これのインターフェースには悩みますね！！
以下のようにしました。
'================================================================
Sub test1()
Dim rng As Range
Set rng = Range("a2", Cells(Rows.Count, 1).End(xlUp)) '＊
If rng.Row > 1 Then '＊
Call 集計(rng, 0) 'Ａ列の集計
end if
End Sub
'===============================================================
Sub test2()
Dim rng As Range
Set rng = Range("a2", Cells(Rows.Count, 1).End(xlUp)) '＊
If rng.Row > 1 Then '＊
Call 集計(rng, 1) 'Ｂ列の集計
end if
End Sub
'===============================================================
Sub test3()
Dim rng As Range
Set rng = Range("a2", Cells(Rows.Count, 1).End(xlUp)) '＊
If rng.Row > 1 Then '＊
Call 集計(rng, 2) 'Ｃ列の集計
end if
End Sub
'===============================================================
Sub test4()
Dim rng As Range
Set rng = Range("a2", Cells(Rows.Count, 1).End(xlUp)) '＊
If rng.Row > 1 Then '＊
Call 集計(rng,0, 2) 'Ａ列とＣ列の組合せ集計
end if
End Sub
'=============================================================
Sub 集計(基準セル範囲 As Range, ParamArray 比較列() As Variant)
'基準セル範囲を基準に比較列として指定されたオフセット位置で集計を行う
'Input--基準セル範囲：集計を行う基準になるセル範囲（列方向のセル範囲を指定する例-A1:A6）
' 比較列:集計する列を基準セル範囲からのオフセット値で指定する
' 例1 セル範囲Ａ２：Ａ６を集計する
' call 集計(range("a1:a6"),0)
'
' 例2 セル範囲ｂ２：ｂ６を集計する
' call 集計(range("a1:a6"),1)
' 又は call 集計(range("b1:b6"),0)
'
' 例3 セルＡ２：Ｂ６を集計する
' call 集計(range("a1:a6"),0,1)
'
' 例4 セルA２：A６を基準セルとしてＡ列とＣ列で集計する
' call 集計(range("a1:a6"),0,2)
Dim dic As Object
Dim idx As Long
Dim crng As Range
Dim cnt As Long
Dim keystr As String
Dim s_tag As Variant
Dim s_val As Variant
ReDim compstr(0 To UBound(比較列()))
Set dic = CreateObject("scripting.dictionary")
With dic
For Each crng In 基準セル範囲
For idx = LBound(比較列()) To UBound(比較列())
compstr(idx) = CStr(crng.Offset(0, 比較列(idx)).Value)
Next
keystr = Join(compstr(), "-")
If .Exists(keystr) Then
.Item(keystr) = .Item(keystr) + 1
Else
.Add keystr, 1
End If
Next
cnt = .Count
s_tag = Application.Transpose(.keys)
s_val = Application.Transpose(.items)
With 基準セル範囲
.Offset(.Count + 1, 0).Resize(cnt, 1).Value = s_tag
.Offset(.Count + 1, 1).Resize(cnt, 1).Value = s_val
.Offset(.Count + 1, 0).Resize(cnt, 2).Sort _
Key1:=.Offset(.Count + 1, 1), _
Order1:=xlDescending, Header:=xlNo
'↑ソートする
End With
End With
Set dic = Nothing
End Sub
確認してみて下さい。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
