Excel VBAのカウントについて

質問

Excel2003で表を作成しています。
画像のような表を作成しているのですが、
左のデータから右の表に数を入力するのに、VBAで出来ないでしょうか？
COUNTIFを使おうと思ったのですが、COUNTの条件が3つありますし、
左のABCの列は500行くらいデータが入っているので出来ればVBAで出来たらと思いました。

回答No.1

Wendy02 · ベストアンサー

こんばんは。

VBAを使わなくても、作業列で、3列を、= A2&B2&C2 というように合わせて、 COUNTIF で数えてもよいと思います。ただ、それはどなたかにおまかせします。私は、VBA中心ですから、コードで回答しておきます。とは言っても、純粋に、VBAのコードで書くと、手間が多いので、数式を使います。

ただし、数式にエラーが発生すると、マクロ自体は止まりませんが、表の中にエラー値が出てきてしまいます。表の項目から、検索値を取り出しますから、表の項目が間違っていたり、スペースが入っていたり、ダブっていたりしたら、間違った答えが出てきてしまいます。

マクロを実行する前に、データや項目にスペースがないように、置換などを加えると確実だと思います。

標準モジュール
'-------------------------------------------
Sub MacroTest1()
　　Dim Rng As Range
　　Dim Srch1 As Variant
　　Dim Srch2 As Variant
　　Dim i As Variant
　　Dim v As Variant, w As Variant
　　Dim x As Long, y As Long
　　Dim startR As Range
　　With ActiveSheet
　　　　'-------------------------------------------
　　　　'データ: A1から下,右3列
　　　　Set Rng = .Range("A1", .Cells(Rows.Count, 1).End(xlUp).Resize(, 3))
　　　　'列の項目
　　　　Srch1 = .Range("E2", .Cells(Rows.Count, 5).End(xlUp)).Value
　　　　'行の項目
　　　　Srch2 = .Range("F1", .Cells(1, Columns.Count).End(xlToLeft)).Value
　　　　'表のスタート
　　　　Set startR = Range("F2")
　　　　'-------------------------------------------
　　　　y = 1
　　　　Application.ScreenUpdating = False
　　　　For Each v In Srch1
　　　　　　x = 1
　　　　　　For Each w In Srch2
　　　　　　　　i = Evaluate("SUM((" _
　　　　　　　　& Rng.Columns(1).Address & "= """ & v & """)*(" _
　　　　　　　　& Rng.Columns(2).Address & "= """ & Left(w, Len(w) - 1) & """)*(" _
　　　　　　　　& Rng.Columns(3).Address & "= """ & Right(w, 1) & """))")
　　　　　　　　.Range("F2").Cells(y, x).Value = i
　　　　　　　　x = x + 1
　　　　　　Next w
　　　　　　y = y + 1
　　　　Next v
　　　　Application.ScreenUpdating = True
　　End With
　　Set Rng = Nothing
End Sub

お礼

回答して頂きありがとうございます。
早速VBAを実行してみたのですが、思っていた通りに表の1行目に数字が入りました。
が、表の2行目に行くと「プロシージャの呼び出し、または引数が不正です」とエラーになってしまいました。
まだ初歩しか勉強していないので、自分ではどうしてそうなってしまうのかよく分かりませんが、もっと勉強して調べてみようと思います。
本当にありがとうございました。

回答No.2

Wendy02

こんばんは。

これは、VBAというよりも、ワークシートの関数をフルに使っているだけです。後は、それをVBAで埋めていくだけです。

>表の2行目に行くと「プロシージャの呼び出し、または引数が不正です」とエラーになってしまいました。

それは、空のデータを読んでいるからで、おそらく、右端に、間の開いたデータがあるからだと思います。
正しく、長方形のデータを読んでいません。

　　　　'-------------------------------------------
　　　　'データ: A1から下,右3列
　　　　Set Rng = .Range("A1", .Cells(Rows.Count, 1).End(xlUp).Resize(, 3))
　　　　'列の項目
　　　　Srch1 = .Range("E2", .Cells(Rows.Count, 5).End(xlUp)).Value
　　　　'行の項目
　　　　Srch2 = .Range("F1", .Cells(1, Columns.Count).End(xlToLeft)).Value　'←ここを交換
　　　　'表のスタート
　　　　Set startR = Range("F2")
'-------------------------------------------
　　　　'検査用コード
　　　　 MsgBox .Range("E2", .Cells(Rows.Count, 5).End(xlUp)).Address
　　　　 MsgBox .Range("F1", .Cells(1, Columns.Count).End(xlToLeft)).Address
　　　　 Stop 'ここで再び止まる。
　　　　'-------------------------------------------

簡単に、チェックする方法は、列の項目、行の項目が、「検査用コード」を加えてください。また、項目が、実際は、A/B でなく、1文字や2文字と変化するようでしたら、現在のマクロでは上手くいきません。検査後は、不要ですから、コメントブロックか、削除してしまってください。

こちらとしては、想定外ですが、Srch2 の部分を、これに置き換えてみても良いかもしれません。

Srch2 = .Range("F1", .Cells(1, 6).End(xlToRight)).Value

という方法もあります。

なぜ、このような書き方をするかというと、実際の大きさが分からないからで、決まっているものなら、End プロパティを使わずに、.Range("F1:L1").Value などとしてもよいです。

お礼

何度も回答して頂きありがとうございます。
とても助かりました！