Excel VBA質問箱 IV

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

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


10859 / 13644 ツリー ←次へ | 前へ→

【19525】ユニークコードの集計 R 04/11/6(土) 18:40 質問[未読]
【19531】Re:ユニークコードの集計 ちゃっぴ 04/11/7(日) 0:58 発言[未読]
【19532】Re:ユニークコードの集計 Hirofumi 04/11/7(日) 8:52 回答[未読]

【19525】ユニークコードの集計
質問  R  - 04/11/6(土) 18:40 -

引用なし
パスワード
   皆さん、はじめまして。
初心者なもので教えてほしいのですが、

A列  A  B  A  C  B  B  
B列 200 100 500 200 200 300
   ↓
   ↓          ↓
  A 2件 700 
  B 3件 600
  C 1件 200

上記のようにA列の値をキーにして集計しデータの個数とB列の数字の
合計を別シートに展開したいのですがこんなことってできるのでしょうか?
ピボットテーブルを使えば出来るのですが、VBAで出来たら!と思いまして・・
色々調べてみたのですが分かりません(悲)
やさしく教えていただけないでしょうか?よろしくお願いします。



【19531】Re:ユニークコードの集計
発言  ちゃっぴ  - 04/11/7(日) 0:58 -

引用なし
パスワード
   Dictionaryを使う方法が一般的ですね。

【19532】Re:ユニークコードの集計
回答  Hirofumi  - 04/11/7(日) 8:52 -

引用なし
パスワード
   かな?

集計データがSheet1に有リ、列見出しが有るとします
結果をSheet2に出力します

Option Explicit

Public Sub AddUp()

  '集計列数を設定
  Const clngCol As Long = 3
  'データ列数を設定
  Const clngData As Long = 2
  
  Dim i As Long
  Dim lngRow As Long
  Dim rngListTop As Range
  Dim dicIndex As Object
  Dim vntResult() As Variant
  Dim vntData As Variant
  Dim lngIndex As Long
  Dim lngNumb As Long
  
  'A列の列見出しの位置を基準とする
  Set rngListTop = Worksheets("Sheet1").Cells(1, "A")
  
  '基準位置に就いて
  With rngListTop
    'データ行数を取得
    lngRow = .Offset(65536 - .Row).End(xlUp).Row - .Row
  End With
  
  'Dictionaryオブジェクトを取得
  Set dicIndex = CreateObject("Scripting.Dictionary")
  
  'Dictionaryに就いて
  With dicIndex
    '列位置の初期値
    lngNumb = 1
    'データ行全てに繰り返す
    For i = 1 To lngRow
    '列見だしが無い場合
'    For i = 0 To lngRow
      'A列以降のセルの値を配列に取得
      With rngListTop
        vntData = .Offset(i).Resize(, clngData).Value
      End With
      'DictionaryにKey名が有った場合
      If .Exists(vntData(1, 1)) Then
        '結果配列の列位置を取得
        lngIndex = .Item(vntData(1, 1))
        'Keyの有る行の個数列にデータの個数を加算
        vntResult(2, lngIndex) _
            = vntResult(2, lngIndex) + 1
        'Keyの有る行のB列の値を加算
        vntResult(3, lngIndex) _
            = vntResult(3, lngIndex) + vntData(1, 2)
      '担当名が無い場合
      Else
        'DictionaryにKey名と列位置(配列の)を追加
        .Add vntData(1, 1), lngNumb
        '結果用配列を拡張
        ReDim Preserve vntResult(1 To clngCol, 1 To lngNumb)
        '果用配列に、値を代入
        vntResult(1, lngNumb) = vntData(1, 1)
        vntResult(2, lngNumb) = 1
        vntResult(3, lngNumb) = vntData(1, 2)
        '列位置を更新
        lngNumb = lngNumb + 1
      End If
    Next i
  End With
  
  'Dictionaryを破棄
  Set dicIndex = Nothing
  
  '結果をSheet2に出力
  With Worksheets("Sheet2").Cells(1, "A")
    .Resize(UBound(vntResult, 2), _
          UBound(vntResult, 1)).Value _
            = Application.Transpose(vntResult)
  End With
  
  Set rngListTop = Nothing
  
  Beep
  MsgBox "処理が完了しました"
  
End Sub

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