Excelの指定列で指定文字列を含む、セル個数を集計するコードをご紹介します。
目次
マクロ機能が有効なExcelブック「.xlsm」を作成
Excelブック「.xlsm」の作成方法が不明な場合は、下記の記事を参考にして下さい。
【エクセルVBA】マクロ機能が有効なExcelブック「.xlsm」の作り方
コードを標準モジュールに貼り付け
標準モジュールの開き方が不明な場合は、下記の記事を参考にして下さい。
【エクセルVBA】標準モジュールの開き方
標準モジュールを開いて、下記のコードを貼り付けて下さい。
コード
指定列で指定文字列を含む、セルの個数を集計する
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 | Sub SearchAndCountOccurrences() Dim ws As Worksheet Dim resultSheet As Worksheet Dim searchStr As String Dim count As Long Dim lastRow As Long Dim lastCol As Long Dim searchCol As Long Dim headerCell As Range Dim resultRow As Long Dim resultMessage As String ' メッセージを格納する変数 Dim anyNonZero As Boolean ' 結果がゼロ以外の検索文字列があったかどうか ' 集計結果シートが存在しない場合、作成する On Error Resume Next Set resultSheet = ThisWorkbook.Sheets("集計結果") On Error GoTo 0 If resultSheet Is Nothing Then ' 集計結果シートが存在しない場合、新たに作成 Set resultSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count)) resultSheet.Name = "集計結果" ' A1セルに「検索文字列」、B1セルに「個数」と入力 resultSheet.Cells(1, 1).Value = "検索文字列" resultSheet.Cells(1, 2).Value = "個数" ' A2セルに「検索希望の文字列を入力して下さい。」とメッセージを表示 resultSheet.Cells(2, 1).Value = "A2セル以降に検索希望の文字列を入力して下さい。" ' メッセージを表示 MsgBox "シート「集計結果」が存在しなかったため、新しく作成しました。" & vbCrLf & _ "A2セル以降に検索文字列を入力してから、再度マクロを実行してください。" Exit Sub End If ' アクティブなシートを設定 Set ws = ActiveSheet ' 集計結果シートのB列をクリア（古いカウント結果を削除） resultSheet.Range("B2:B" & resultSheet.Cells(resultSheet.Rows.count, 1).End(xlUp).Row).ClearContents ' 集計結果シートのA2セル以降に記載された検索文字列を順に処理 resultRow = 2 ' 結果記入をB2セルから開始 resultMessage = "" ' メッセージの初期値を空に設定 anyNonZero = False ' 結果がゼロ以外の検索文字列があったかどうか ' アクティブシートの1行目（ヘッダー行）を取得 lastCol = ws.Cells(1, ws.Columns.count).End(xlToLeft).Column ' 集計結果シートのA2セル以降に記載された検索文字列を順に処理 Do While resultSheet.Cells(resultRow, 1).Value <> "" searchStr = resultSheet.Cells(resultRow, 1).Value ' 検索する文字列が空でないか確認 If searchStr = "" Then MsgBox "検索する文字列が空です。" Exit Sub End If ' 1行目で検索文字列に一致する列を検索 searchCol = 0 For Each headerCell In ws.Range(ws.Cells(1, 1), ws.Cells(1, lastCol)) If headerCell.Value = searchStr Then searchCol = headerCell.Column Exit For End If Next headerCell ' 検索文字列が見つからなかった場合 If searchCol = 0 Then resultSheet.Cells(resultRow, 2).Value = "該当列なし" resultMessage = resultMessage & "検索文字列 """ & searchStr & """ : 該当列なし。" & vbCrLf Else ' 検索対象の列のデータ範囲を取得 lastRow = ws.Cells(ws.Rows.count, searchCol).End(xlUp).Row ' 該当列にある「〇」の個数をカウント count = 0 For i = 2 To lastRow ' 2行目から最終行まで調べる If ws.Cells(i, searchCol).Value = "〇" Then count = count + 1 End If Next i ' 結果を「集計結果」シートに記載 resultSheet.Cells(resultRow, 2).Value = count ' もしカウントがゼロでない場合、anyNonZeroをTrueに設定し、メッセージに追加 If count > 0 Then anyNonZero = True resultMessage = resultMessage & "検索文字列 """ & searchStr & """ : " & count & " 回" & vbCrLf Else resultMessage = resultMessage & "検索文字列 """ & searchStr & """ : 0 回" & vbCrLf End If End If ' 次の行へ進む resultRow = resultRow + 1 Loop ' 結果がゼロ以外の検索文字列があった場合、メッセージを表示 If anyNonZero Then MsgBox "検索が完了しました。" & vbCrLf & resultMessage Else ' 全ての結果がゼロの場合、特別なメッセージを表示 MsgBox "検索文字列の検索結果は全て0個でした。" End If End Sub |
マクロを実行
上記で作成したマクロファイル（ここでは「指定列で指定文字列を含む、セル個数を集計する.xlsm」とファイル名を設定。）を準備します。
マクロファイルを開いて、「コンテンツの有効化」をクリックします。
※設定により、「コンテンツの有効化」は表示されない（クリック不要の）場合もあります。
本ファイルの初期設定ではシートは「Sheet1」のみ存在しています。
また、予め下記の様に入力しています。
「開発」タブ、「マクロ」の順にクリックします。
マクロ「SearchAndCountOccurrences」を選択、「実行」をクリックします。
マクロが実行され、ウィンドウが表示されるので、「OK」をクリックします。
シート「集計結果」が作成されます。
A1、A2、B1セルに入力されます。
A2セル以降に、検索したいシート「Sheet1」の1行目に入力されている文字列を入力します。
シート「Sheet1」を選択します。
マクロ「SearchAndCountOccurrences」を選択、「実行」をクリックします。
マクロが実行され、ウィンドウが表示されます。
集計結果が表示されるので、確認して「OK」をクリックします。
シート「集計結果」を開くと、B列に集計結果が入力されます。
完了です。
検索する指定文字列が存在しない場合
シート「Sheet1」に存在しない文字列をA列に入力します。
マクロを実行すると、「該当列なし」と表示されます。
シート「集計結果」のB列に「該当列なし」と入力されます。
参考サイト
ChatGPTを活用して、修正を加えてコードを作成しました。
