Excel VBA質問箱 IV

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

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


47919 / 76738 ←次へ | 前へ→

【33764】Dictionaryによる集計
質問  ponpon  - 06/1/19(木) 23:10 -

引用なし
パスワード
   こんばんは。
dictinaryの勉強をしようと思い、
いい課題があったので考えたのですが・・・

シート1のA列にコード(文字列)、B列に売上(数値)各見出しあり、
同様にシート2のA列にコード(文字列)、B列に売上(数値)各見出しあり
があります。

シート1("田中")
   A    B
1 コード  売上
2 001234  2000
3 001235  3000
4 001236  300
5 001237  4000
6 ……   ……

シート2("山田")
   A    B
1 コード  売上
2 001233  2000
3 001234  3000
4 001237  300
5 001238  4000
6 ……   ……
シート1とシート2のA列には重複があります。
各シートのA列には重複はありません。

これをシート3("集計")に
A列に重複のないコードを、B列にコード別の売上(シート1)、
C列にコード別の売上(シート2)のように集計したいのです。
   A    B    C
1 コード 売上(田中) 売上(山田)
2 001233        2000
3 001234  2000   3000
4 001235  3000
5 001236  300
6 001237  4000   300
7 001238        4000
8 ……   ……

そこで、以下のように組んだのですが、
シート1だけにしかないものがうまく集計されません。

Splitで配列にして書き出しているので、
Dic.Item(myVal(i, 1)) = myVal(i, 2)が配列にならないのだと思うのですが
どうしたらよいかわかりません。
ご指導をお願いします。

Sub test()
  Dim SH1 As Worksheet, SH2 As Worksheet, SH3 As Worksheet
  Dim Dic As Object
  Dim i As Long, j As Long
  Dim myVal, myVal2
  
  Set SH1 = Worksheets("田中")
  Set SH2 = Worksheets("山田")
  Set SH3 = Worksheets("集計")
  Set Dic = CreateObject("Scripting.Dictionary")
  
  myVal = SH1.Range("A2", SH1.Range("B65536").End(xlUp)).Value
  myVal2 = SH2.Range("A2", SH2.Range("B65536").End(xlUp)).Value
  
  For i = 1 To UBound(myVal, 1)
   Dic.Item(myVal(i, 1)) = myVal(i, 2) ’ここがダメだと思う
  Next
  For j = 1 To UBound(myVal2, 1)
    If Dic.Exists(myVal2(j, 1)) Then
     Dic.Item(myVal2(j, 1)) = Dic.Item(myVal2(j, 1)) & "," & myVal2(j, 2)
    Else
     Dic.Item(myVal2(j, 1)) = "" & "," & myVal2(j, 2)
    End If
  Next
  
  
  With SH3
   .Cells.ClearContents
   .Range("A1:C1").Value = Array("コード", "売上(田中)", "売上(山田)")
   
   i = 2
   For Each key In Dic.keys()
     .Cells(i, 1).Value = key
     .Cells(i, 2).Resize(1, 2).Value = Split(Dic.Item(key), ",")
     i = i + 1
   Next
   .Columns.AutoFit
   .Range("A1").CurrentRegion.Sort Key1:=Range("A2"), Order1:=xlAscending, _
    Header:=xlGuess, OrderCustom:=1
 
  End With


End Sub
0 hits

【33764】Dictionaryによる集計 ponpon 06/1/19(木) 23:10 質問
【33765】Re:Dictionaryによる集計 ichinose 06/1/19(木) 23:59 発言
【33784】Re:Dictionaryによる集計 ponpon 06/1/20(金) 13:35 お礼

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