エクセルである範囲のセルから文字列を抜き出して集計

質問

エクセルである範囲のセルの中から文字列を抜き出して出現回数を求めたいと思っております。

A1：あああ,いいい,ううう A2：いいい,えええ
b1：かかか,えええ,ううう B2：ううう,いいい,おおお

解答
あ：1
い：3
う：3
え：2
お：1

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

回答No.5

tom04 · ベストアンサー

たびたびごめんなさい。

＞n = WorksheetFunction.Match(tmp, ws2.Columns(1), False)
で止まります

というコトはMatch関数の検査範囲に検査値がないエラーだと思われます。

もう一度コードをよくよく確認してみると
怪しい行がありました。

＞For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
の行でSheetを指定していませんでした。
＞For i = 1 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
に変更してみてください。

他の原因ならごめんなさいね。m(_ _)m

お礼

謝るのはこちらの方です。。。
＞For i = 1 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
に変更いたしましたが、同じ結果となりました。
しかし、出現回数上位のキーワードが大分採れましたので
非常に助かりました。
感謝の言葉もございません。
私に知識がないばかりにデバックの原因を探る事ができずに申し訳ありません。
tom04様をベストアンサーに選ばせていたいただくことは変わりません。
もし、他にも考えられることがございましたらもう少しお付き合い頂けたらと思いますのでよろしくお願い致します。
現在のモジュールの記述は以下となっております。

Sub test() 'この行から
Dim i As Long
Dim j As Long
Dim k As Long
Dim n As Long
Dim cnt As Long
Dim myArray As Variant
Dim tmp As Variant
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
ws2.Range("A:B").ClearContents
For i = 1 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To 2
If InStr(ws1.Cells(i, j), ",") Then
myArray = Split(ws1.Cells(i, j), ",")
For k = 0 To UBound(myArray)
tmp = myArray(k)
If WorksheetFunction.CountIf(ws2.Columns(1), tmp) = 0 Then
cnt = cnt + 1
With ws2.Cells(cnt, 1)
.Value = tmp
.Offset(, 1) = 1
End With
Else
n = WorksheetFunction.Match(tmp, ws2.Columns(1), False)
ws2.Cells(n, 2) = ws2.Cells(n, 2) + 1
End If
Next k
End If
Next j
Next i
End Sub 'この行まで

回答No.7

米沢 栄蔵（@YON56）

8年位前にこのサイトでdagajamajaさんと同じ質問をし、
ある回答者の方から「目から鱗が落ちる」回答をを頂きましたので、
それを披露します。
<考え方>
「ある文字列から特定の文字の出現回数を数える」ということは、
「ある文字列の総文字数」から「ある文字列の特定の文字を取り除いた総文字数」を減算することである。

セルA1にある文字列(XYZAXXXJK)が入っているとします。
特定文字が「X」とします。
<関数式>
=Len(A1)-Len(Substitute(A1,"X",""))　結果は4
<VBA>
A=Range("A1").Value
B=Len(A)-Len(Replace(A,"X",""))

ちなみに、「X」を「XX」としてみて下さい。結果は2となります。

こういう計算を何回やってそれをどういう風に表示するかはご自分で

お礼

YON56さま
ご回答ありがとうございます。
こういったやり方もあるんですね。
勉強になります。
気に留めていただき感謝しております。
ありがとうございました。

回答No.6

tsubuyuki

横入り、大変失礼ながら。

件の
> n = WorksheetFunction.Match(tmp, ws2.Columns(1), False)
の部分を　
　n = ws2.Columns("A:A").Find(What:=tmp, LookAt:=xlWhole).Row
に書き換えるとどうなりますか。

余計なお節介ですが、デバッグは無理だとしても、
実行した結果、Sheet2にどこまで表示されたか・・
例えば、提示された地名を使ったサンプルで実行してみて
　東京　　　3
　広島　　　1
　東京都　　1
　大島　　　1
まで表示されたところでエラーが出る、とかを提示すると
「二つ目の“大島”の判断でエラーが出てるな」と察することができます。
（あくまでも例えば、です。）
その情報により、ＴＯＭ０４さんの検証も楽になるかもしれません。

ちなみに私はＴＯＭ０４さんご提示のコードを
EXCEL2003+VBA6.0、EXCEL2010+VBA7.0の環境でテストをしましたが、
エラーは発生しませんでした。
使っている環境で答えが変わることも多いですので、明記されると良いかもしれません。

以上、横槍失礼しました。

お礼

ありがとうございました。
本番環境で動くことが確認されました。
ちなみに環境はEXCEL2010+VBA7.0の環境でした。
いまさらですが、おっしゃる通り情報をうまくお伝えできておりませんでした。
改めて皆様の貴重なお時間をいただき感謝しております。

回答No.4

tom04

続けてお邪魔します。

何とか把握できたような感じがします。
いずれにしてもVBAになってしまいますが・・・

Sheet1のA・B列にデータがあるとし、Sheet2に表示するようにしてみました。
Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub test() 'この行から
Dim i As Long
Dim j As Long
Dim k As Long
Dim n As Long
Dim cnt As Long
Dim myArray As Variant
Dim tmp As Variant
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
ws2.Range("A:B").ClearContents
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To 2
If InStr(ws1.Cells(i, j), ",") Then
myArray = Split(ws1.Cells(i, j), ",")
For k = 0 To UBound(myArray)
tmp = myArray(k)
If WorksheetFunction.CountIf(ws2.Columns(1), tmp) = 0 Then
cnt = cnt + 1
With ws2.Cells(cnt, 1)
.Value = tmp
.Offset(, 1) = 1
End With
Else
n = WorksheetFunction.Match(tmp, ws2.Columns(1), False)
ws2.Cells(n, 2) = ws2.Cells(n, 2) + 1
End If
Next k
End If
Next j
Next i
End Sub 'この行まで

こんな感じではどうでしょうか？m(_ _)m

お礼

ありがとうございます！
無事動きました！
途中で実行時エラー1004WorksheetFunctionクラスのMatchプロパティを取得できません。
というメッセージが出現しデバックすると
n = WorksheetFunction.Match(tmp, ws2.Columns(1), False)
で止まります。
止まっているキーワード部分を確認しましたが特に変わった部分はないようです。
（他と変わらずカンマ区切りで、機種依存文字もないようです）

回答No.3

tom04

続けてお邪魔します。

ん～～～
補足を読ませてもらっても、質問内容がはっきり把握できません。

＞この集計したい文字列は、何が記述されているかわからない前提です。
＞全件単位の集計で更に1つのセルに同じ文字が入っている場合もあります。
＞あああ,あああ,いいい
＞などです

（1）1セル内にカンマ区切りでいくつかの文字列がある
（2）同じセル内に　あああ,あああ,いいい　とある場合は「あ」が二つと計算する
（3）何が記述されているかわからないというコトは、一旦記述されている文字列を重複なしに抽出しなければならない！
（4）あああ　→　「あああ」が一つではなく、「あ」が一つ？

というコトでしょうか？

もしそうであれば仮に「あいう,あああ,いうい」といったセルがある場合はどういう判断をするのか？
一文字ずつ舐めるように検索するのか？

その辺が不透明（当方の理解力が乏しいのかも・・・）なので具体的な回答ができません。
もっと具体的に判別できる材料が判れば他の方からももっと良いアドバイスがあると思います。

いずれにしても関数では難しそうなので、VBAになるかもしれませんね。

この程度でごめんなさい。m(_ _)m

補足

とんでもございません。
私の説明不足です。
(1)カンマ区切りで文字列が記述されています。
(2)同じセル内のカンマ区切りに同じ文字列があった場合は「2」と判断します。
(3)何が記述されているか膨大な数なのでカンマ区切りで文字列を判断しなくてはなりません。
(4)「あああ」はカンマで区切られた文字列なのであくまでも「あああ」です。
なので
あいう,あああ,いういは「あいう」「あああ」「いうい」と判断します。
以下にわかりやすいように地名で例を表しました。

　　　　　　　A　　　　　　　　　　　B
　 1　東京,広島,東京 　東京都,東京,大島
　 2　大島,大分,長野 　岐阜,長野,長崎県,長野

　 　 東京 　 2
　 　 東京都 　 1
　 　 広島 　 1
　 　 大島 　 2
　 　 大分 　 1
　 　 長野 　 2
　 　 静岡 　 1
　 　 岐阜 　 1
　 　 長崎県 　 1

統計的にどんな単語がどのくらい含まれているかを知りたいと思っております。
いかがでしょうか。
よろしければ引き続きよろしくお願いいたします。

回答No.2

tom04

No.1です！
投降後に気づきました。

もうお判りだと思いますが、D列に　あ～お　を入れていますので、
数式を入れるのはE1セルですね。

アップした画像を見て間違いに気づきました。
どうも失礼しました。m(_ _)m

補足

素早いご回答ありがとうございます。
説明不足で申し訳ございません。
この集計したい文字列は、何が記述されているかわからない前提です。
全件単位の集計で更に1つのセルに同じ文字が入っている場合もあります。
あああ,あああ,いいい
などです。
貴重なお時間裂いてしまって大変失礼いたしました。
お分かりになりましたら引き続きよろしくお願いいたします。

回答No.1

tom04

こんにちは！
一例です。
A・B列が対象であるならば・・・

↓の画像のように「あ」～「お」までの表を作成しておきます。

そして、D1セルに
=IF(D1="","",COUNTIF(A:B,"*"&D1&"*"))
という数式を入れオートフィルで下へコピーすると
画像のような感じになります。m(_ _)m