| |
こんにちは。
>しかし、実行してみたところ、一行目 - をつけることにより
>日付と認識するらしく、5月 日というように項目名が変更されてしまいます。
>"-" に" - "ｽﾍﾟｰｽを入れてもダメでした
>> keystr = Join(compstr(), "-")
>> If .Exists(keystr) Then
>> .Item(keystr) = .Item(keystr) + 1
こんな場合ですか？
セルＡ１から
Ａ Ｂ
１ 項目1 項目2
２ 1 11
３ 2 12
４ 3 13
５ 4 14
６ 5 15
７ 6 16
８ 7 17
こんなデータが入っているとき、
'==================================
Sub test()
Dim rng As Range
Set rng = Range("a2", Cells(Rows.Count, 1).End(xlUp)) '＊
If rng.Row > 1 Then '＊
Call 集計(rng, 0, 1) 'Ａ列とＢ列の組合せ集計
End If
End Sub
を実行すると、
セルＡ１０から、
1月11日
2月12日
3月13日
4月14日
5月15日
6月16日
7月17日
という結果が表示されてしまいます。
とここまで記述して下さい。
入力データが何なのかを明確に記述する事ですよ！！
今回は見当がついたからよかったですけど・・・。
これは、集計プロシジャーを
'================================================================
Sub 集計(基準セル範囲 As Range, ParamArray 比較列() As Variant)
'基準セル範囲を基準に比較列として指定されたオフセット位置で集計を行う
'Input--基準セル範囲：集計を行う基準になるセル範囲（列方向のセル範囲を指定する例-A1:A6）
' 比較列:集計する列を基準セル範囲からのオフセット値で指定する
' 例1 セル範囲Ａ２：Ａ６を集計する
' call 集計(range("a2:a6"),0)
'
' 例2 セル範囲ｂ２：ｂ６を集計する
' call 集計(range("a2:a6"),1)
' 又は call 集計(range("b2:b6"),0)
'
' 例3 セルＡ２：Ｂ６を集計する
' call 集計(range("a2:a6"),0,1)
'
' 例4 セルA２：A６を基準セルとしてＡ列とＣ列で集計する
' call 集計(range("a2: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).NumberFormatLocal = "@"
' 追加して下さい↑
.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
|
|
ichinose
- 06/2/13(月) 14:33 -
