Excel VBA質問箱 IV

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

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


3235 / 76735 ←次へ | 前へ→

【79133】dictionary item 追加されない
質問  T-K  - 17/5/20(土) 23:38 -

引用なし
パスワード
   データより、クロス集計表をVBAで作成しようとしています。
前回もこちらでお世話になりましたが、再度ご教授お願いします。
A列 品名 B列 数字 C列日付 D列 数字のデータが
あります。(データ数不定)それを
A列とC列の値をKeyとして取込み、itemをD列の値で取込み
それをクロス集計表に作成したいとおもっています。
重複している場合はD列の値を追加するながれです。
ネット検索して使えそうなサンプルがあり、少しだけ加工処理してみましたが、
ローカルで確認するとD列の値が、Itemとして追加されていません。
データ型が違うのが原因なのか、インデックスが有効範囲にないだけなのか
原因がわからないためわかるかたがいたらよろしくお願いします。
下記にマクロ記入します

Sub test51()
  Dim myDic As Object, myKey, myItem
  Dim myVal, myVal2
  Dim i As Long, j As Long
  Dim sh1 As Worksheet
    Set myDic = CreateObject("Scripting.Dictionary")
    Set sh1 = Worksheets("Sheet1")
    ' ---元データを配列に格納
    myVal = sh1.Range("A1").CurrentRegion.Value
    ' ---myDicへデータを格納
    For i = 1 To UBound(myVal, 1)
      myVal2 = myVal(i, 1) & "_" & myVal(i, 3)
      If Not myVal2 = "_" Then
        If Not myDic.exists(myVal2) Then
          myDic.Add myVal2, myVal(i, 4)’登録されていない
        Else
          myDic(myVal2) = myDic(myVal2) + myVal(i, 4)
        End If
      End If
    Next
    ' ---Key,Itemの書き出し
    For i = 2 To 1000
      For j = 2 To 1000
        Cells(i, j).Value = myDic(Cells(i, 2).Value & "_" & Cells(2, j).Value)
       
      Next j
    Next i

    Set myDic = Nothing
    Set sh1 = Nothing
End Sub

0 hits

【79133】dictionary item 追加されない T-K 17/5/20(土) 23:38 質問[未読]
【79134】Re:dictionary item 追加されない カリーニン 17/5/21(日) 0:47 発言[未読]
【79140】Re:dictionary item 追加されない T-K 17/5/21(日) 9:45 お礼[未読]
【79135】Re:dictionary item 追加されない γ 17/5/21(日) 1:05 発言[未読]
【79136】Re:dictionary item 追加されない γ 17/5/21(日) 6:33 発言[未読]
【79137】Re:dictionary item 追加されない T-K 17/5/21(日) 7:25 質問[未読]
【79138】Re:dictionary item 追加されない γ 17/5/21(日) 7:55 発言[未読]
【79139】Re:dictionary item 追加されない T-K 17/5/21(日) 9:43 お礼[未読]
【79141】Re:dictionary item 追加されない γ 17/5/21(日) 12:04 発言[未読]
【79142】Re:dictionary item 追加されない T-K 17/5/21(日) 16:49 お礼[未読]

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