VBA シート別カウント

質問

お世話になります。

只今、VBAでどのように複数の文言をカウントすればいいのか悩んでいます。

集計シートに、Sheet１～５０までのA列にある文言をカウントしたいです。
A列には、りんご、ばなな、メロン、他50種類あるとします。
集計シートには縦に、Sheet1~50が並んでおり、
横にりんご、ばなな、メロンが横に重複削除して並んでいます。
りんごの下にカウントした数字を入れていきたいです。

現在、Cell(3,3) =　WorksheetFunction.CountIF(Sheets("Sheet1").Range("A2:A100"),cells(2,2))
とマクロを組むと、一つだけしかとってこれない状態ですが、これを複数取ってくる場合はどのようにしたらよいのでしょうか。

よろしくお願いいたします。

回答No.5

HohoPapa · ベストアンサー

>現在、Cell(3, 3) = WorksheetFunction.CountIf(Sheets("Sheet1").Range("A2:A100"), Cells(2, 2))
これを生かし、複数シート、複数単語を対象に
マクロを実行することで実現するのであれば

添付画像を例に
以下のコードはいかがでしょうか？

Sub Sample()

　Dim RowCnt As Long
　Dim ColCnt As Long
　Dim PutWs As Worksheet
　Dim GetWs As Worksheet

　Set PutWs = ThisWorkbook.Sheets("集計")
　RowCnt = 2

　Do

　　ColCnt = 2
　　If PutWs.Cells(RowCnt, 1).Value = "" Then Exit Do
　　Set GetWs = ThisWorkbook.Sheets(PutWs.Cells(RowCnt, 1).Value)

　　Do
　　　If PutWs.Cells(1, ColCnt).Value = "" Then Exit Do
　　　PutWs.Cells(RowCnt, ColCnt).Value = _
　　　　WorksheetFunction.CountIf(GetWs.Range("A2:A100"), PutWs.Cells(1, ColCnt).Value)
　　　ColCnt = ColCnt + 1
　　Loop

　　RowCnt = RowCnt + 1

　Loop

End Sub

お礼

無事にカウントすることが出来ました！
本当に本当にありがとうございます！！！！

回答No.4

HohoPapa

VBAで専用の関数を用意し、その関数で数える対応はいかがでしょうか。
よりシンプルですので、レイアウトや仕様の変更にも対応しやすいと思います。

添付画像のような配置を前提に
以下のコードです。
このコードを標準モジュールに配置します。

Function KeyCount(SHName As String, word As String) As Long

　Dim RowCnt As Long
　Dim LastRow As Long
　Dim HitCnt As Long

　HitCnt = 0
　With ThisWorkbook.Sheets(SHName)
　　LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
　　For RowCnt = 1 To LastRow
　　　If .Cells(RowCnt, 1).Value = word Then
　　　　HitCnt = HitCnt + 1
　　　End If
　　Next RowCnt
　End With
　KeyCount = HitCnt

End Function

続いて、
集計シートのB2セルに
=KeyCount($A2,B$1)
と埋め、必要数、右、下方向に複写します。

回答No.3

ken-nosuke

No1.の方は、文言が不定の前提なのですごく複雑になります。
貴質問は、文言が５０種類とあるので固定していると考えれば関数で対応できます。
集計シート（Sheet51）に　B1＝りんご、A2＝Sheet1　とすると　Sheet1のりんごの数は次のようになります。
B2 =COUNTIF(Sheet1!$A$1:$A$100,Sheet51!B$1)
B2のセルをC2,D2,・・・にコピーするとそれぞれC1,D1・・の文言の個数を表示します。
ここで　$A$1:$A$100　や　B$1　の＄は絶対参照にするという記号でコピーしても変化しません。＄が無いとコピーで移動した分参照先も移動します。（相対参照）
次にB2のセルをB3のセルにコピーし式の中の　”Sheet1”　を　”Sheet２”　に変えます。
B3のセルをC3,D3,・・・にコピーします。
以下同様にSheet3以降にコピーしていきます。
残念ながら、関数で、Sheet１，２，３を自動変更する手法は知りません。

VBAでFor　Next　の知識があれば手間は省けます。

Sub Macro1()
For j = 2 To 5
A = Sheets("Sheet51").Cells(j, 1)
For i = 2 To 5
Sheets("Sheet51").Cells(j, i) = WorksheetFunction.CountIf(Sheets(A).Range("A1:A50"), Sheets("Sheet51").Cells(1, i))
Next i
Next j
End Sub

回答No.2

chayamati

VBAがなくともCOUNTA関数で間に合いますが
敢えてVBAなら
――――――――-----------------------------------
Sub 集計()
Sheets("集計").Select
Range("A3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=COUNTA(Sheet1!C)"
Range("B3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=COUNTA(Sheet2!C[-1])"
Range("C3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=COUNTA(Sheet3!C[-2])"
Range("D3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=COUNTA(Sheet4!C[-3])"
End Suｂ
―――――――------------------------------------------------------------------------
以上ですが,
　上記は列全体の件数です。見出し行の引算も
　50Sheetともなると命令文が膨大になります
　　Doループ,Forループ等での工夫も必要でしょう

回答No.1

imogasi

質問が載って以来相当時間が経っているが、回答が載らない。
いつもすぐＶＢＡ回答を出す」常連さんも数人いるのにね。
ーー
質問の表現や説明が、エクセルの普通の通り行われていない。
＞Sheet１～５０までのA列にある文言
とは、文章がおかしい。
例えばＳｈｅｅｔ１、Ｓｈｅｅｔ２、・・Ｓｈｅｅｔ５０のシートがあり
その各々のＡ列に文字列の語句があり、そ語句ごとに、出現数をカウントして、その数を
問題にしたいのか。
それとＳｈｅｅｔ１、Ｓｈｅｅｔ２‥別に、文字列語句ごとに分けて数を出したいらしいな。
こういうクロス表は、システムで用意してくれてないと、難しいのだ。
色々なロジックがあるが、Ｓｈｅｅｔ１－Ｓｈｅｅｔ１のＡ列の文字列語句の
バリエーションを算出するのがまず難しい。
１シートなら、データーフィルター重複するデータは無視する、で出せる。
しかし、５０シートの範囲でそれを確定するのは、難しい
で、
Ｓｈｅｅｔ１
語句
aa
ss
dd
ff
ee
aa
ss
dd
Ｓｈｅｅｔ２
語句
aa
sss
dd
fff
ee2
aa
ss2
Ｓｈｅｅｔ３
語句
ssd
dfg
vvv
ff
ee2
aa
ssss
ddx
Ｓｈｅｅｔ５は
aa
ss
dd
ff
ee
aa
ss
dd
aa
sss
dd
fff
ee2
aa
ss2
ssd
dfg
vvv
ff
ee2
aa
ssss
ddx
ここで、データーフィルター重複するデータは無視するで
aa
ss
dd
ff
ee
aa
sss
fff
ee2
ss2
ssd
dfg
vvv
ssss
ddx
これ等の語句を、Ａ列そして、第１行Ｂ列以下をＳｈｅｅｔ１，Ｓｈｅｅｔ２，ーーーにして
クロスしたセルにＣＯＵＮＴＩＦ関数を入れて、出現語句数を算出してはどうだろう。
＞データーフィルター重複するデータは無視する
や
＞クロスしたセルにＣＯＵＮＴＩＦ関数を入れて、出現語句数を算出
はＶＢＡでもできるが、初心者はできる部分は市道でやるのが鉄則
その後ＶＢあに進めばよい。