エクセルマクロVBAで、特定の文字列を含むセルや行を対象にして処理を行うプログラムを紹介します。
・セルに特定文字列が含まれていれば、セルの色を変更
・行に特定文字列が含まれていれば、その行を削除
・特定文字列が含まれる列を別シートへ抽出
上記のような処理を実行するVBAプログラムを実行します。
目次
1. Instrでセルに特定の文字列が入っている件数をカウント
以下の作業をVBAで行います。
・セルB2~B21に「ある文字列」が入っていれば、セルC2~セルC21に「該当」
・セルF2に合計件数を出力
VBAプログラムは以下です。
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 |
'プログラム0｜変数宣言の指定 Option Explicit 'プログラム1｜プログラム開始 Sub Excel_Instr() 'プログラム2｜対象シートを設定 Dim Ws As Worksheet Set Ws = Worksheets("Sheet10") 'プログラム3｜最終行の取得 Dim Cmax As Long Cmax = Ws.Range("A65536").End(xlUp).Row 'プログラム4｜検索ワードの設定 Dim Keyword As String Keyword = "愛" 'プログラム5｜変数定義 Dim i As Long, Kensu As Long Dim Torihiki As String 'プログラム6｜B列の値を取得 For i = 2 To Cmax Torihiki = Ws.Range("B" & i).Value 'プログラム7｜B列に検索ワードが含まれるかチェック If InStr(Torihiki, Keyword) > 0 Then Ws.Range("C" & i).Value = "該当" 'プログラム8｜件数をカウント Kensu = Kensu + 1 End If Next 'プログラム9｜F2に出力 Ws.Range("F2").Value = Kensu 'プログラム10｜プログラムの終了 End Sub |
プログラムの詳細は以下で説明しています。
2. Findで特定の文字を含むセルを探し位置を全て範囲選択
・キーワードを含むセルを選択
・複数キーワードの場合、一つでもキーワードを含むセルを選択
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 |
'プログラム0｜変数宣言の指定 Option Explicit 'プログラム1｜プログラム開始 Sub SelectCellsWithKeywords() 'プログラム2｜キーワードを入力 Dim keywords As String keywords = InputBox("対象にしたい文字列を記入。複数ある場合は、「,」で区分けすること") 'プログラム3｜キーワードがない場合、プログラムを終了 If keywords = "" Then: Exit Sub 'プログラム4｜シート設定 Dim ws As Worksheet Set ws = ActiveSheet 'プログラム5｜変数設定 Dim selectrng As Range, rng As Range, firstrng As Range Dim keyword As Variant 'プログラム6｜入力したキーワードを一つずつ処理 For Each keyword In Split(keywords, ",") 'プログラム7｜Findで対象キーワードのセルを見つける Set rng = ws.cells.Find(keyword, Lookat:=xlPart) Debug.Print rng.Address 'プログラム8｜対象キーワードのセルがなければContinue(プログラム13)へ If rng Is Nothing Then: GoTo Continue Set firstrng = rng 'プログラム9｜selectrngに対象セルを格納 If selectrng Is Nothing Then Set selectrng = rng Else Set selectrng = Union(selectrng, rng) End If 'プログラム10｜キーワードを含むセルを一つずつ繰り返し取得 Do Set rng = ws.cells.FindNext(rng) Debug.Print rng.Address 'プログラム11｜キーワードを含むセルがfirstrngと同じなら、Continue(プログラム13)へ If rng.Address = firstrng.Address Then: GoTo Continue 'プログラム12｜selectrngにrngを格納 Set selectrng = Union(selectrng, rng) Loop 'プログラム13｜プログラム8とプログラム11のジャンプ先 Continue: Next 'プログラム14｜キーワードが含まれているセルを選択 If Not selectrng Is Nothing Then: selectrng.Select 'プログラム15｜プログラム終了 End Sub |
3. 特定の文字を含むセルに色を付ける
上の図では、対象文字列「愛知」と「手数料」の2つのキーワードの内、どちらか一方を含んでいるセルを黄色にしています。
このように特定の文字列を含むセルに色を付けていきます。
・キーワードを含むセルを色を付ける
・複数キーワードの場合、一つでもキーワードを含むセルに色を付ける
以下がVBAプログラムです。
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 |
'プログラム0｜変数宣言の指定 Option Explicit 'プログラム1｜プログラム開始 Sub ColorCellsWithKeywords() 'プログラム2｜キーワードを入力 Dim keywords As String keywords = InputBox("対象にしたい文字列を記入。複数ある場合は、「,」で区分けすること") 'プログラム3｜キーワードがない場合、プログラムを終了 If keywords = "" Then: Exit Sub 'プログラム4｜シート設定 Dim ws As Worksheet Set ws = ActiveSheet 'プログラム5｜対象セル範囲を設定 Dim myrange As Range Set myrange = ws.UsedRange() 'プログラム6｜シート内の全てのセルに対して処理 Dim cell As Range For Each cell In myrange 'プログラム7｜1行目(ヘッダー)のセルは省略 If cell.Row = 1 Then: GoTo Continue 'プログラム8｜入力したキーワードを一つずつ処理 Dim keyword As Variant For Each keyword In Split(keywords, ",") 'プログラム9｜対象セルがキーワードを含んでいれば黄色、いなければ色をなくす If InStr(cell.Value, keyword) > 0 Then cell.Interior.ColorIndex = 6 Exit For Else cell.Interior.ColorIndex = xlNone End If Next 'プログラム10｜プログラム7のジャンプ先 Continue: Next 'プログラム11｜プログラム終了 End Sub |
以下で詳しくお伝えしています。
4. セルの色に応じて行や列を表示・非表示にする
VBAを使うと色の塗りつぶしがない行や列の表示・非表示を切り替えることができます。
このページでは色のついたセルがある行や列のみを表示したり非表示にしたりするプログラムを紹介します。
・行の表示・非表示の切り替え（セルが色で塗りつぶされているかどうかを判定）
・列の表示・非表示の切り替え（セルが色で塗りつぶされているかどうかを判定）
・VBA入りのエクセルファイルをダウンロード可能
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 |
'プログラム0｜変数宣言の指定 Option Explicit 'プログラムA-1｜プログラム開始 Sub Sample1_HideRows() 'プログラムA-2｜最終行を取得 Dim cmax As Long cmax = Range("C65536").End(xlUp).Row 'プログラムA-3｜最終行まで処理 Dim i As Long For i = 5 To cmax 'プログラムA-4｜色で塗りつぶされている行があるかどうかチェック If Rows(i).Interior.ColorIndex = xlNone Then 'プログラムA-4-1｜色で塗りつぶされていない行を非表示 Rows(i).Hidden = True Else 'プログラムA-4-2｜色で塗りつぶされている行を非表示 'Rows(i).Hidden = True End If Next 'プログラムA-5｜プログラム終了 End Sub |
以下のページでプログラムの詳しい説明を行っています。
5. 複数の特定の文字列を含む行を削除
エクセルマクロVBAで、特定の文字列を含む行を削除するプログラムを紹介します。
特定の文字列が複数でも対応できるプログラムをお伝えします。
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 |
'プログラム0｜変数宣言の指定 Option Explicit 'プログラム1｜プログラム開始 Sub DeleteRowsWithStrings() 'プログラム2｜キーワードを入力 Dim keywords As String keywords = InputBox("削除したい文字列を記入。複数ある場合は、「,」で区分けすること") 'プログラム3｜キーワードがない場合、プログラムを終了 If keywords = "" Then: Exit Sub 'プログラム4｜シートコピー Dim ws As Worksheet ActiveSheet.Copy after:=ActiveSheet Set ws = ActiveSheet 'プログラム5｜変数設定 Dim myrange As Range Dim keyword As Variant 'プログラム6｜キーワードを一つずつ処理 For Each keyword In Split(keywords, ",") 'プログラム7｜対象シートでキーワードが一つでも含まれている行を削除 Do Set myrange = ws.Cells.Find(keyword, Lookat:=xlPart) If myrange Is Nothing Then: Exit Do Rows(myrange.Row).Delete Loop Next 'プログラム8｜プログラム終了 End Sub |
以下のリンクで詳しくお伝えしていきます。
6. 複数の特定の文字を含む行に色を付ける、含まない行に色を付ける
エクセルマクロVBAで、複数の特定文字列を1つでも含む行の色を変更するプログラムを紹介します。
具体的には、以下の2つをこのページで説明します。
・複数(1つでも可能)の特定文字列を含む行だけ色を付ける
・複数(1つでも可能)の特定文字列を含む行だけ色を付けない
特定の文字列が1つの場合でも対応できるプログラムとなっています。
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 |
'プログラム0｜変数宣言の指定 Option Explicit 'プログラム1｜プログラム開始 Sub ColorRowsWithKeywords() 'プログラム2｜キーワードを入力 Dim keywords As String keywords = InputBox("抽出の対象となる文字列を記入。複数ある場合は、「,」で区分けすること") 'プログラム3｜キーワードがない場合、プログラムを終了 If keywords = "" Then: Exit Sub 'プログラム4｜シート設定 Dim ws As Worksheet Set ws = ActiveSheet 'プログラム5｜シートの最右列を取得 Dim col As Long col = ws.UsedRange.Columns.Count 'プログラム6｜変数設定 Dim rng As Range Dim keyword As Variant 'プログラム7｜2行目以降を行ごとに取得 Dim i As Long For i = 2 To ws.UsedRange.Rows.Count Set rng = ws.UsedRange.Rows(i) 'プログラム8｜対象行にデータが含まれていなければプログラム11へ If WorksheetFunction.CountA(rng) = 0 Then: GoTo Continue 'プログラム9｜プログラム2の全キーワードを繰り返し処理 For Each keyword In Split(keywords, ",") 'プログラム10｜各行にキーワードを含むセルがあれば行を黄色、なければ色をなくす If Not rng.Find(keyword, Lookat:=xlPart) Is Nothing Then ws.Range(Cells(i, 1), Cells(i, col)).Interior.ColorIndex = 6 Exit For Else ws.Range(Cells(i, 1), Cells(i, col)).Interior.ColorIndex = xlNone End If Next 'プログラム11｜プログラム8のジャンプ先 Continue: Next 'プログラム12｜プログラム終了 End Sub |
プログラムの詳しい説明は以下で行っています。
7. ある特定の文字列を含む行を別シートに抽出
エクセルマクロVBAで、複数の特定文字列を1つでも含む行を別シートへ抽出するプログラムを紹介します。
なお、特定の文字列が1つの場合でも対応できるプログラムとなっています。
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 |
'プログラム0｜変数宣言の指定 Option Explicit 'プログラム1｜プログラム開始 Sub GetRowsWithKeywords() 'プログラム2｜キーワードを入力 Dim keywords As String keywords = InputBox("抽出の対象となる文字列を記入。複数ある場合は、「,」で区分けすること") 'プログラム3｜キーワードがない場合、プログラムを終了 If keywords = "" Then: Exit Sub 'プログラム4｜シート設定 Dim ws1 As Worksheet Set ws1 = Worksheets("Sheet1") 'プログラム5｜抽出データ出力用のシート追加 Dim ws2 As Worksheet Set ws2 = Worksheets.Add(after:=ws1) ws2.Name = "NewSheet" 'プログラム6｜抽出先のシートの初期値を設定 Dim k As Long k = 2 'プログラム7｜変数設定 Dim rng As Range Dim keyword As Variant 'プログラム8｜対象データを行ごとに処理 Dim i As Long For i = 1 To ws1.UsedRange.Rows.Count 'プログラム9｜1行目(ヘッダー)を抽出先のシートへ出力(コピー) If i = 1 Then ws1.Rows(1).Copy (ws2.Rows(1)) End If 'プログラム10｜2行目以降を行ごとに取得 If i >= 2 Then Set rng = ws1.UsedRange.Rows(i) 'プログラム11｜プログラム2のキーワードを全て取得 For Each keyword In Split(keywords, ",") 'プログラム12｜各行にキーワードを含むセルがあれば If Not rng.Find(keyword, Lookat:=xlPart) Is Nothing Then 'プログラム13｜キーワードを含む行を抽出用シートへ出力 ws1.Rows(i).Copy (ws2.Rows(k)) k = k + 1 Exit For End If Next End If Next 'プログラム14｜プログラム終了 End Sub |
プログラムの詳しい説明は以下で行っています。
8. ある特定の文字列を含む列を別シートに抽出
エクセルマクロVBAで、特定文字列を含む列を別シートへ抽出するプログラムを紹介します。
なお、特定の文字列は1つでも複数でも対応できるプログラムとなっています。
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 |
'プログラム0｜変数宣言の指定 Option Explicit 'プログラム1｜プログラム開始 Sub GetColumnsWithKeywords() 'プログラム2｜キーワードを入力 Dim keywords As String keywords = InputBox("抽出の対象となる文字列を記入。複数ある場合は、「,」で区分けすること") 'プログラム3｜キーワードがない場合、プログラムを終了 If keywords = "" Then: Exit Sub 'プログラム4｜シート設定 Dim ws1 As Worksheet Set ws1 = Worksheets("Sheet1") 'プログラム5｜抽出データ出力用のシート追加 Dim ws2 As Worksheet Set ws2 = Worksheets.Add(after:=ws1) ws2.Name = "NewSheet" 'プログラム6｜列番号として使用する変数kを設定 Dim k As Long k = 1 'プログラム7｜最終行の行番号をcmaxとして設定 Dim cmax As Long cmax = ws1.UsedRange.Rows.Count 'プログラム8｜変数設定 Dim rng As Range Dim keyword As Variant 'プログラム9｜対象データを列ごとに処理 Dim i As Long For i = 1 To ws1.UsedRange.Columns.Count 'プログラム10｜全ての列を列ごとに取得 Set rng = ws1.Range("A1:A" & cmax).Offset(0, i - 1) 'Set rng = ws1.Range(cells(1, i), cells(cmax, i)) Debug.Print rng.Address 'プログラム11｜プログラム2のキーワードを全て取得 For Each keyword In Split(keywords, ",") 'プログラム12｜各列にキーワードを含むセルがあれば If Not rng.Find(keyword) Is Nothing Then 'プログラム13｜キーワードを含む列を抽出用シートへ出力 ws1.Columns(i).Copy (ws2.Columns(k)) k = k + 1 Exit For End If Next Next 'プログラム14｜プログラム終了 End Sub |
以下で詳しく説明します。
