Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


46951 / 76736 ←次へ | 前へ→

【34752】Re:カウント方法について
発言  ichinose  - 06/2/10(金) 23:29 -

引用なし
パスワード
   ▼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) 'A列の集計
    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) 'B列の集計
    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) 'C列の集計
    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) 'A列とC列の組合せ集計
    end if
End Sub


'=============================================================
Sub 集計(基準セル範囲 As Range, ParamArray 比較列() As Variant)
'基準セル範囲を基準に比較列として指定されたオフセット位置で集計を行う
'Input--基準セル範囲:集計を行う基準になるセル範囲(列方向のセル範囲を指定する例-A1:A6)
'    比較列:集計する列を基準セル範囲からのオフセット値で指定する
' 例1  セル範囲A2:A6を集計する
'    call 集計(range("a1:a6"),0)
'
' 例2  セル範囲b2:b6を集計する
'    call 集計(range("a1:a6"),1)
'  又は call 集計(range("b1:b6"),0)
'
' 例3  セルA2:B6を集計する
'    call 集計(range("a1:a6"),0,1)
'
' 例4  セルA2:A6を基準セルとしてA列とC列で集計する
'    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


確認してみて下さい。

0 hits

【34650】カウント方法について hatena 06/2/9(木) 10:47 発言
【34655】Re:カウント方法について ichinose 06/2/9(木) 12:58 発言
【34660】Re:カウント方法について hatena 06/2/9(木) 14:30 質問
【34667】Re:カウント方法について hatena 06/2/9(木) 15:53 質問
【34678】Re:カウント方法について ichinose 06/2/9(木) 18:31 発言
【34710】Re:カウント方法について hatena 06/2/10(金) 12:04 お礼
【34733】Re:カウント方法について hatena 06/2/10(金) 18:21 質問
【34752】Re:カウント方法について ichinose 06/2/10(金) 23:29 発言
【34754】Re:カウント方法について ichinose 06/2/11(土) 5:48 発言
【34796】Re:カウント方法について hatena 06/2/13(月) 11:39 発言
【34805】Re:カウント方法について ichinose 06/2/13(月) 14:33 発言
【34818】Re:カウント方法について hatena 06/2/13(月) 18:42 お礼
【34662】Re:カウント方法について Kein 06/2/9(木) 15:00 回答
【34709】Re:カウント方法について hatena 06/2/10(金) 12:02 質問
【34713】Re:カウント方法について Kein 06/2/10(金) 13:47 回答
【34715】Re:カウント方法について hatena 06/2/10(金) 14:33 質問
【34716】Re:カウント方法について Kein 06/2/10(金) 14:48 回答

46951 / 76736 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free