こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

VBA 連想配列と回数

Widowsは7
Excelは2013を使用しています。

E列のデータの重複しないリストをK列に書きだすところまでは出来たのですが、
同じ商品名が何回出てきたをカウントしたいのですが、
下記の連想配列で一緒に出来るのか、分けて組まないといけないのか、
教えて下さい。
よろしくお願い致します。
'----------------------------
'重複しないリストをK列に書き出す
'----------------------------

Dim Dic, i As Long, buf As String, Keys
Set Dic = CreateObject("Scripting.Dictionary")

For i = 2 To maxRow
buf = Cells(i, 5).Value 'E列のセルの値をbufに格納する
If Not Dic.Exists(buf) Then '辞書にまだ登録されていなければ
Dic.Add buf, buf 'そのセルの値を連想配列に登録する。
End If

Next i

'出力
Keys = Dic.Keys
For i = 0 To Dic.Count - 1
Cells(i + 2, 11) = Keys(i) 'K2から下にリスト作成
Next i
Set Dic = Nothing
End Sub

投稿日時 - 2018-03-02 14:52:05

QNo.9434357

困ってます

質問者が選んだベストアンサー

>E列からI列まで一括で出来ますか?
各列の最終行がE列と同じなら
Sub Test2()
  Dim Dic As Object, c As Range
  Set Dic = CreateObject("Scripting.Dictionary")
  For Each c In Range("E2:I" & Cells(Rows.Count, "E").End(xlUp).Row)
    Dic(c.Value) = Dic(c.Value) + 1
  Next
  '出力
  Range("K2").Resize(Dic.Count, 1).Value = Application.Transpose(Dic.Keys)
  Range("L2").Resize(Dic.Count, 1).Value = Application.Transpose(Dic.Items)
  Set Dic = Nothing
End Sub
各列の最終行がE列と異なるのなら
Sub Test3()
  Dim Dic As Object, i As Long, j As Long, buf As String
  Set Dic = CreateObject("Scripting.Dictionary")
  For i = 5 To 9 'E列からI列
    For j = 2 To Cells(Rows.Count, i).End(xlUp).Row
      buf = Cells(j, i).Value
      Dic(buf) = Dic(buf) + 1
    Next j
  Next i
  '出力
  Range("K2").Resize(Dic.Count, 1).Value = Application.Transpose(Dic.Keys)
  Range("L2").Resize(Dic.Count, 1).Value = Application.Transpose(Dic.Items)
  Set Dic = Nothing
End Sub

投稿日時 - 2018-03-03 13:52:34

補足

watabe007様
質問の返答を頂き、色々パターンを書いてくださって有り難く思います。
最終行が同じ方を組み込んでみたいです。
今は手元にないので、月曜日にやってみます。
お礼コメントは、その後に書かせていただきたいので、
少し時間を下さい。
本当にありがとうございました。

投稿日時 - 2018-03-03 15:26:16

お礼

watabe007様
E~Iまで書き出す事ができました!

私がE2→E最終行→F2→F最終行・・・・・という様に書き出したい事を、質問で説明していなかったでしで、少し思ったのと違う結果になってしまいました。
申し訳ありませんが、もう少し考えてみます。

ご回答いただきました事、感謝致します。
ありがとうございました。

投稿日時 - 2018-03-05 11:19:35

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(5)

ANo.5

>私がE2→E最終行→F2→F最終行・・・・・という様
???
E列の重複しないリストと重複数は、K、L列に
F列の重複しないリストと重複数は、M、N列に
・・・
なら
Sub Test4()
  Dim Dic As Object, i As Long, j As Long, buf As String, k As Long
  Set Dic = CreateObject("Scripting.Dictionary")
  k = 11
  For i = 5 To 9 'E列からI列
    For j = 2 To Cells(Rows.Count, i).End(xlUp).Row
      buf = Cells(j, i).Value
      Dic(buf) = Dic(buf) + 1
    Next j
    '出力
    Cells(2, k).Resize(Dic.Count, 1).Value = Application.Transpose(Dic.Keys)
    Cells(2, k + 1).Resize(Dic.Count, 1).Value = Application.Transpose(Dic.Items)
    k = k + 2
    Dic.RemoveAll
  Next i
  Set Dic = Nothing
End Sub

投稿日時 - 2018-03-05 11:44:58

お礼

watabe007様

ご回答いただきありがとうございます。
回数をカウントして出力するのはそのままですが、
すこし集計方法が変わりそうなので、このスレッドは解決とさせて頂きたく、お願い致します。

回答No.5の方もよく拝見して勉強させて頂きます。
(多分、別の案件につながると思います。)
色々ご教授頂き本当にありがとうございました。

投稿日時 - 2018-03-05 16:01:18

ANo.3

参考に
Sub Test()
  Dim Dic As Object, c As Range
  Set Dic = CreateObject("Scripting.Dictionary")
  For Each c In Range("E2", Cells(Rows.Count, "E").End(xlUp))
    Dic(c.Value) = Dic(c.Value) + 1
  Next
  '出力
  Range("K2").Resize(Dic.Count, 1).Value = Application.Transpose(Dic.Keys)
  Range("L2").Resize(Dic.Count, 1).Value = Application.Transpose(Dic.Items)
  Set Dic = Nothing
End Sub

投稿日時 - 2018-03-02 22:35:43

お礼

watabe007様
ありがとうございます。
書いてくださったのを活用させていただくと、
E列からI列まで一括で出来ますか?

投稿日時 - 2018-03-03 12:26:34

ANo.2

#1です。
ごめんなさい。
Dic.Add buf, buf 'そのセルの値を連想配列に登録する。

Dic.Add buf, 1 'そのセルの値を連想配列に登録する。
に書き換えるというのが,抜けていました。

投稿日時 - 2018-03-02 16:03:29

補足

Dic.Add buf, buf  と Dic.Add buf, 1 の違い、
分かりました。
私の思い違いで理解出来てなかった事が、
回答頂いたのをきっかけに理解する事ができました。
ありがとうございました。

投稿日時 - 2018-03-03 15:51:11

お礼

f272様
出来ました!
大変ありがとうございました。
1日悩んでいたことから、次に進むことが出来ます。
感謝です。

もしお時間がありましたら、
Dic.Add buf, buf  と Dic.Add buf, 1 の違いを教えて頂けないでしょうか?

同じ商品名が出てきたら、+1づつカウントしていく、と思って良いのでしょうか?

投稿日時 - 2018-03-02 16:14:59

ANo.1

Dic.Add buf, buf 'そのセルの値を連想配列に登録する。
の下に
Else
Dic(buf) = Dic(buf) + 1
を追加して,書き出しの
Cells(i + 2, 11) = Keys(i) 'K2から下にリスト作成
の下に
Cells(i + 2, 12) = Dic(Keys(i))
を追加すればどうかな?

投稿日時 - 2018-03-02 15:16:59

補足

f272様
ご回答いただきありがとうございます。
Dic(buf) = Dic(buf) + 1 のことろで、
エラーコード 13 の 型が一致しませんになってしまいました。

投稿日時 - 2018-03-02 15:44:36

あなたにオススメの質問