戻る  □一般操作のサロン  □ 使用方法  □ 新着記事  □ 新規に質問する!  □ トピック一覧  □ 検索  □ 過去ログ
[ 最新記事及び返信フォームをトピックトップへ ]
このトピック参照回数 :
Dictionaryでカウントしたい

    [191665] Dictionaryでカウントしたい-

    ■親トピック/記事引用/メール受信=OFF■

    □投稿者/ はじめ -(2020/04/02(13:08))
    □U R L/
      VBAを勉強中です。
      複数条件にあったものをカウントしたいです。
      ご教授ください。
      
      縦にあるデータ一覧から、行と列に合致するものの個数を集計したいです。
      データはA1〜に番号、I1〜に文字が縦に入っており
      合計表にはD3〜から横に番号、B7〜下に文字があります。
      D7〜集計結果を表示させたいです。
      インターネットのコードを使ってみたのですがセルに反映させる方法がわかりません。
      
      データ
      A	B	C	D	E	F	G	H	I
      1	--	--	--	--	--	--	--	みかん
      3	--	--	--	--	--	--	--	オレンジ
      5	--	--	--	--	--	--	--	ぶどう
      6	--	--	--	--	--	--	--	もも
      1	--	--	--	--	--	--	--	みかん
      2	--	--	--	--	--	--	--	みかん
      7	--	--	--	--	--	--	--	ぶどう
      8	--	--	--	--	--	--	--	オレンジ
      4	--	--	--	--	--	--	--	もも
      
      合計表
      A	B	C	D	E	F	G	H	I	J	K	L	M
      --	--	--	1	2	3	4	5	6	7	8	9	10
      --	--	--										
      --	--	--										
      --	--	--										
      --	みかん											
      --	ぶどう											
      --	もも											
      --	オレンジ											
      
      
      
      Option Explicit
      
      Sub Sample1()
      
              Dim aV, kV, Key As String
              Dim r As Long, c As Long, rr As Long, myDic As Object
              
              kV = Worksheets("データ").Range("A2:I10")                       'データ
              aV = Worksheets("合計").Range("B3:M10")                       '合計
              
              Set myDic = CreateObject("Scripting.Dictionary")
              For r = 1 To UBound(kV)
              Key = kV(r, 1) & kV(r, 9)
                  If Not myDic.Exists(Key) Then
                      myDic.Add Key, 1
                  Else
                      myDic(Key) = myDic(Key) + 1
                  End If
              Next r
              
              For c = 1 To UBound(aV)
                  For rr = 4 To UBound(aV)
                      Key = aV(rr, 1) & aV(1, c)
                      aV(rr, c) = myDic(Key)
                  Next rr
              Next c
              
              ’★Worksheets("合計").Range(Cells(7, 4), Cells(7, 13)) =        '結果出力
              Set myDic = Nothing
              
          End Sub
      
      よろしくお願いします。
      
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191667] (削除)-

    記事引用/メール受信=OFF■

    □投稿者/ / -(2020/04/02(17:51))
    □U R L/

      この記事は削除されました




    [191668] Re[2]: Dictionaryでカウントしたい-

    記事引用/メール受信=OFF■

    □投稿者/ ぴんく -(2020/04/02(18:18))
    □U R L/
       >縦にあるデータ一覧から、行と列に合致するものの個数を集計したいです。
      
      どの様にしたいのか解らない?
      
      Sub Sample2()
          Dim myDic As Object, c As Range, n As Long
          
          Set myDic = CreateObject("Scripting.Dictionary")
          With Worksheets("データ")
              For Each c In .Range("I1:I9")
                  myDic(c.Value) = myDic(c.Value) + .Cells(c.Row, "A").Value
              Next
          End With
          With Worksheets("合計")
              For Each c In .Range("B7:B10")
                  n = myDic(c.Value)
                  c.Offset(, 1).Value = n
                  .Cells(c.Row, n + 3).Value = "*"
              Next
          End With
          Set myDic = Nothing
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191670] Re[3]: Dictionaryでカウントしたい-

    記事引用/メール受信=OFF■

    □投稿者/ はじめ -(2020/04/02(20:00))
    □U R L/

      ぴんく 様

      回答ありがとうございます。
      わかりづらい説明ですみません。

      D7には、「1みかん」がデータの中にいくつあるか
      データA列番号の合計ではなく
      A列が「1」でI列が「みかん」の組み合わせの個数を集計したいです。

      どうぞよろしくお願いいたします。




    [191671] Re[4]: Dictionaryでカウントしたい-

    記事引用/メール受信=OFF■

    □投稿者/ マナ -(2020/04/02(20:24))
    □U R L/

      Dictionaryでも可能ですが
      簡単に、COUNTIFS関数ではだめなのでしょうか。




    [191672] Re[5]: Dictionaryでカウントしたい-

    記事引用/メール受信=OFF■

    □投稿者/ ぴんく -(2020/04/02(20:50))
    □U R L/
      >データA列番号の合計ではなく
      >A列が「1」でI列が「みかん」の組み合わせの個数を集計したいです。
      これで良いのか?
      
      Sub Sample3()
          Dim myDic As Object, c As Range, n As Long
          Dim myStr As String, v As Variant
          
          Set myDic = CreateObject("Scripting.Dictionary")
          With Worksheets("データ")
              For Each c In .Range("I1:I9")
                  If Not myDic.Exists(c.Value) Then
                      ReDim v(1 To 10)
                      v(.Cells(c.Row, "A").Value) = 1
                  Else
                      v = myDic(c.Value)
                      v(.Cells(c.Row, "A").Value) = v(.Cells(c.Row, "A").Value) + 1
                  End If
                  myDic(c.Value) = v
              Next
          End With
          With Worksheets("合計")
              For Each c In .Range("B7:B10")
                  c.Offset(, 2).Resize(, 10).Value = myDic(c.Value)
              Next
          End With
          Set myDic = Nothing
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191673] Re[5]: Dictionaryでカウントしたい-

    記事引用/メール受信=OFF■

    □投稿者/ はじめ -(2020/04/02(20:52))
    □U R L/

      マナさん 返信ありがとうございます。
      サンプルは少ないですが、実際は大量の項目があるので
      COUNTIFS関数ではとても時間がかかっていますので
      改善したくこちらにご相談しました。
      配列の一部をセルに反映する方法を教えていただきたく・・・
      提示したコードが間違っているようでしたらご指摘ください。
      よろしくお願いします。




    [191674] Re[6]: Dictionaryでカウントしたい-

    記事引用/メール受信=OFF■

    □投稿者/ マナ -(2020/04/02(21:01))
    □U R L/

      合計表の、文字と数字は、予め入力されているのでしょうか。
      数字は、実際も連番なのでしょうか。

      >実際は大量の項目

      縦横。それぞれ何個あるのでしょうか。






    [191675] Re[7]: Dictionaryでカウントしたい-

    記事引用/メール受信=OFF■

    □投稿者/ はじめ -(2020/04/02(21:10))
    □U R L/

      マナさん ありがとうございます。
      合計表の、文字と数字は、予め入力されています。
      数字は、実際も連番です。
      データ数は10000件で
      みかんなどの項目は100個です。
      どうぞよろしくお願いします。




    [191676] Re[8]: Dictionaryでカウントしたい-

    記事引用/メール受信=OFF■

    □投稿者/ マナ -(2020/04/02(21:25))
    □U R L/

      >連番です

      何番までですか?




    [191677] Re[8]: Dictionaryでカウントしたい-

    記事引用/メール受信=OFF■

    □投稿者/ はじめ -(2020/04/02(21:28))
    □U R L/

      ぴんくさん ありがとうございます。
      気が付かず、すみませんでした。
      さっそく実行させていただいたら
      v(.Cells(c.Row, "A").Value) = 1
      でエラー9 インデックスが有効範囲にありません・・
      とでました。これは今回何度も苦戦しているエラーです。
      原因が理解できておらす・・勉強不足ですみませんが
      よろしくお願いします。 




    [191678] Re[9]: Dictionaryでカウントしたい-

    記事引用/メール受信=OFF■

    □投稿者/ はじめ -(2020/04/02(21:35))
    □U R L/
      ぴんくさん ありがとうございます!
      
      ReDim v(1 To 10) → ReDim v(0 To 9)
      
      c.Offset(, 2).Resize(, 10).Value = myDic(c.Value)
      →c.Offset(, 1).Resize(, 9).Value = myDic(c.Value)
      
      に変えたらばっちりできました!
      ありがとうございます。助かりました!


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191679] Re[9]: Dictionaryでカウントしたい-

    記事引用/メール受信=OFF■

    □投稿者/ ぴんく -(2020/04/02(22:03))
    □U R L/
      >でエラー9 インデックスが有効範囲にありません・
      
      A列の値が空白だったのでしょう
      
      Sub Sample4()
          Dim myDic As Object, c As Range, n As Long
          Dim myStr As String, v As Variant, d As Variant
          Dim r As Long
          
          Set myDic = CreateObject("Scripting.Dictionary")
          With Worksheets("データ")
              'データーはI1よりI列の最終行まで拾います。
              For Each c In .Range("I1", .Cells(Rows.Count, "I").End(xlUp))
                  'A列の番号が空白、若しくは10より大きい場合は排除します。
                  n = Val(.Cells(c.Row, "A").Value)
                  If n > 0 And n <= 10 Then
                      If Not myDic.Exists(c.Value) Then
                          ReDim v(1 To 10)
                          v(.Cells(c.Row, "A").Value) = 1
                      Else
                          v = myDic(c.Value)
                          v(n) = v(n) + 1
                      End If
                      myDic(c.Value) = v
                  End If
              Next
          End With
          With Worksheets("合計")
              r = 7
              'くだもの名も今後増える事を考慮して自動に書き込みます。
              For Each d In myDic.keys
                  .Cells(r, "B").Value = d
                  .Cells(r, "D").Resize(, 10).Value = myDic(d)
                  r = r + 1
              Next
          End With
          Set myDic = Nothing
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191680] Re[10]: Dictionaryでカウントしたい-

    記事引用/メール受信=OFF■

    □投稿者/ はじめ -(2020/04/02(22:23))
    □U R L/

      マナさん ありがとうございます。
      きがつかなくてすみません。
      連番は35までです。よろしくお願いします。




    [191681] Re[11]: Dictionaryでカウントしたい-

    記事引用/メール受信=OFF■

    □投稿者/ はじめ -(2020/04/02(22:27))
    □U R L/

      ぴんくさん ありがとうございます。
      空白だったから、なんですね。
      Sample4は
      サンプルで試したらうまくいったのですが
      実際のファイルで試すとB列の項目が
      1行とんで下に表示されて集計数字もあいませんでした。
      同じセル番地でサンプルをつくっているのですが・・・
      Sample3では、実際のファイルでもうまくいきました。
      よろしくお願いします。




    [191682] Re[12]: Dictionaryでカウントしたい-

    記事引用/メール受信=OFF■

    □投稿者/ ぴんく -(2020/04/02(22:30))
    □U R L/

      >Sample3では、実際のファイルでもうまくいきました。

      では、それで行きましょう。




    [191683] Re[13]: Dictionaryでカウントしたい-

    記事引用/メール受信=OFF■

    □投稿者/ マナ -(2020/04/02(22:49))
    □U R L/

      >空白だったから、なんですね。

      実際にも、空白もあるのですか?




    [191684] Re[14]: Dictionaryでカウントしたい-

    記事引用/メール受信=OFF■

    □投稿者/ マナ -(2020/04/02(23:02))
    □U R L/
      もう必要ないかもしれませんが
      dictionaryですが、こんな使い方もよく見かけます。
      
      理解しやすいように、エラー対策は、あえてしていません
      空白があれば、エラーです。CurrentRegionもだめですね。
      
      Sub test()
          Dim dic As Object
          Dim v, r As Range
          Dim k As Long
          Dim n As Long, s As String
          Dim w(1 To 100, 1 To 35)
          
              Set dic = CreateObject("scripting.dictionary")
          
              v = Worksheets("データ").Range("A1").CurrentRegion.Columns("A:I").Value
              Set r = Worksheets("合計").Range("B3").Resize(UBound(w))
              
              For k = 2 To UBound(v)
                  n = v(k, 1)
                  s = v(k, 9)
                  If Not dic.Exists(s) Then dic(s) = Application.Match(s, r, 0)
                  w(dic(s), n) = w(dic(s), n) + 1
              Next
              r.Offset(, 2).Resize(, UBound(w, 2)).Value = w
      
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191685] Re[15]: Dictionaryでカウントしたい-

    記事引用/メール受信=OFF■

    □投稿者/ はじめ -(2020/04/02(23:20))
    □U R L/

      マナさん ぴんくさん ありがとうございます。
      実際は空白があります。
      どちらにしても空白の処理が必要になるんですね。
      マナさんのコードもぴんくさんのコード(Sample3)も
      いろいろやってみましたが、空白時の処理がうまくできません。
      何度もすみませんが、どちらか教えてください。
      よろしくお願いしますm(__)m





    [191686] Re[16]: Dictionaryでカウントしたい-

    記事引用/メール受信=OFF■

    □投稿者/ マナ -(2020/04/02(23:37))
    □U R L/
      空白でないときのみ、処理すればよいのです。
      f Not IsEmpty(v(k, 1)) Then
      
      それよりも、まずは、現在のコードで何をしているか理解しないとだめなのでは?
      
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191687] Re[17]: Dictionaryでカウントしたい-

    解決!!ありがとうございました! / 記事引用/メール受信=OFF■

    □投稿者/ はじめ -(2020/04/02(23:50))
    □U R L/

      マナさん
      ありがとうございました。
      ばっちり動きました。
      まだ半分わかっていないので
      このあとひとつづつ検証して
      理解できるように勉強します。
      マナさん ぴんくさん
      おふたりともありがとうございましたm(__)m




このトピック内容の全ページ数 / [0]

このトピックに書きこむ
Name/
E-Mail/

└>このツリーのレス記事をメールで受信しますか? YES/ NO/
Title/
URL/
Comment/ 通常モード->  図表モード-> (←の場合適当に改行を入れて下さい)
タグが使用できます。例 ⇒ <font color="blue">文字</font>
解決!!ありがとうございました! 解決       保留中です・・・ 保留        迷宮入りorほかあたって見ます・・ 迷宮入       すいませ〜ん。誰か〜! Help! ←※回答者専用
解決したらチェック       保留(コードテスト中など・・)         解決不可orレスが全く付かなくてほかのサイトに行くときなど・・
削除キー/
(半角8文字以内) 


- Child Forum -
Edit:ゆう-G