指定した列内の条件に合う行をカラー表示する
このVBAコードは、特定の条件に基づいてExcelワークシートの行を色付けするコードです。
Sub 指定した列内の条件に合う行をカラー表示する()
' 変数の宣言と初期化
Dim i As Long
Dim max_row As Long
max_row = Cells(Rows.Count, 1).End(xlUp).Row
' 最終行までループ
For i = 1 To max_row
' 条件を満たした場合、行全体を色付け
If Cells(i, 3).Value >= 70 Then
Cells(i, 1).EntireRow.Interior.Color = 65535
End If
Next i
' 完了メッセージ
MsgBox "完了"
End Subこのコードは、以下のように動作します。
max_row変数を使用して、シートの最後の行番号を取得します。Forループを使用して、各行について条件式を評価します。- 条件式が
Trueの場合、行全体を黄色に変更します。 - 処理が完了したら、メッセージボックスで完了を通知します。
上記コードの可読性と実行速度が向上させるコード
Sub 指定した列内の条件に合う行をカラー表示する()
' 変数の宣言と初期化
Dim i As Long
Dim max_row As Long
Dim target_sheet As Worksheet
Set target_sheet = ActiveSheet ' 対象のシートをアクティブシートに設定
max_row = target_sheet.Cells(Rows.Count, 1).End(xlUp).Row
' 最終行までループ
For i = 1 To max_row
' 条件を満たした場合、行全体を色付け
If target_sheet.Cells(i, 3).Value >= 70 Then
target_sheet.Cells(i, 1).EntireRow.Interior.Color = 65535
End If
Next i
' 完了メッセージ
MsgBox "完了"
End Sub
主な改善点は以下の通りです。
- 変数target_sheetを宣言して、対象となるシートをActiveSheetsプロパティで指定し、コード内で何度も参照されるActiveSheetプロパティを使うのを避けます。
- 変数max_rowを最終行を取得する1行目のコードに実行時のシートに依存しないように修正し、実行速度を改善します。また、行番号の取得にUsedRange.Rows.Countを使うことで、実際に使われている範囲の行数を取得することができ、実行速度も改善されます。
- 行の条件判定に使われる列を、3列目に固定しています。この列が変更された場合、コードの修正が必要になるため、この列を別の変数で指定するように改善することも検討できます。
この修正により、コードの可読性と実行速度が向上しました。
指定範囲（表）の該当するものをカラー表示する
これは、指定された範囲内のセルについて、値が70以上の場合に背景色を変更するエクセルマクロです。
Sub 指定範囲の該当するものをカラー表示する()
Dim c As Range
Dim my_array As Variant
Dim s_row, s_col As Long
Dim max_row, max_col As Long
s_row = 2
s_col = 2
max_row = ThisWorkbook.ActiveSheet.Cells(Rows.Count, s_col).End(xlUp).Row
max_col = ThisWorkbook.ActiveSheet.Cells(s_row, Columns.Count).End(xlToLeft).Column
'セル範囲を配列に格納
Set my_array = ThisWorkbook.ActiveSheet.Range(Cells(s_row, s_col), Cells(max_row, max_col))
On Error GoTo myError
For Each c In my_array
If c.Value >= 70 Then c.Interior.Color = 65535
Next c
myError:
MsgBox "完了"
End Sub解説
- 変数
cを宣言し、セル範囲を格納するための変数my_array、および範囲の最初の行番号s_row、最初の列番号s_col、最後の行番号max_row、最後の列番号max_colを設定します。 - セル範囲を配列
my_arrayに格納します。 On Error GoTo myErrorを使用して、エラーが発生した場合にジャンプする場所を指定します。For Eachループを使用して、my_array内の各セルcについて、値が70以上の場合に背景色を変更します。- 例外処理ブロックである
myError内で、完了メッセージを表示するようにします。
以上が、このマクロの概要になります。値が70以上のセルがある場合、それらのセルの背景色が変更され、完了メッセージが表示されます。
文字列を検索して該当行を全て検索してカラーで表示後シートに貼付け／find
これは、指定された文字列を検索し、該当する行を全てハイライト表示して新しいシートにコピーするマクロです。
Sub 文字列を検索して該当行を全て検索_新規シートにはりつけ()
Dim fnd As Range
Dim fnd_all As Range
Dim adr As String
Cells.ClearFormats
Dim key As String
Dim rng As Range
key = Application.InputBox("検索するワードを入力してください")
If key = "False" Then
MsgBox ("キャンセルされました")
Exit Sub
End If
Set fnd = ActiveSheet.Cells.Find(What:=key, LookAt:=xlPart)
If fnd Is Nothing Then
MsgBox "見つかりませんでした。"
Exit Sub
Else
Set fnd_all = fnd
adr = fnd.Address
End If
Do
DoEvents
Set fnd = Cells.FindNext(After:=fnd)
If fnd.Address = adr Then
Exit Do
Else
Set fnd_all = Union(fnd_all, fnd)
End If
Loop
fnd_all.EntireRow.Interior.Color = RGB(204, 255, 255)
fnd_all.EntireRow.Copy
Worksheets.Add(After:=ActiveSheet).Name = ActiveSheet.Name & "_" & VBA.Format(Now(), "h時mm分ss秒")
ActiveSheet.Paste
Range("A1").Select
MsgBox "完了： " & fnd_all.Row & " 件"
End Sub解説
- 部分一致：Set fnd = ActiveSheet.Cells.Find(What:=key, LookAt:=xlPart)
- 指定した列の中から検索する場合：Set fnd = Range(“B:B”).Find(“検索ワード”)
key変数に、検索するワードを入力してもらいます。もしキャンセルされた場合は処理を終了します。Cells.ClearFormatsを使って、セルの書式設定をクリアします。ActiveSheet.Cells.Findを使って、検索語句に一致するセルを探します。FindメソッドがNothingを返した場合、検索語句が見つからなかったことを示すメッセージを表示して処理を終了します。Findメソッドが見つかった場合、fnd_allにそのセルを格納し、adrにそのアドレスを格納します。Cells.FindNextを使って、次の一致するセルを探します。見つからなくなるまでDoループを繰り返します。Union関数を使って、fnd_all変数に全ての一致するセルを格納します。fnd_all.EntireRow.Interior.Colorを使って、一致したすべての行の背景色を変更します。fnd_all.EntireRow.Copyを使って、一致したすべての行をコピーします。Worksheets.Addを使って、新しいシートを作成し、コピーした行を貼り付けます。MsgBoxを使って、処理が完了した旨を表示します。
文字列を検索して該当行を全て検索してカラーで表示／find
これは、エクセルのB列に対して、”53“という文字列を含むセルを見つけ、見つかったすべてのセルの背景色を変更するエクセルマクロです。
Sub ファインド連続_見つけたら背景色()
Dim findCell As Range, firstCell As Range, targetRng As Range
Set targetRng = Columns("B")
Set findCell = targetRng.Find(What:="*53*")
If findCell Is Nothing Then
MsgBox "対象文字無し"
Exit Sub
End If
Set firstCell = findCell
Do
findCell.Interior.ThemeColor = msoThemeColorAccent4
Set findCell = targetRng.FindNext(After:=findCell)
Loop Until findCell.Address = firstCell.Address
MsgBox "完了"
End Sub解説
Sub ファインド連続_見つけたら背景色()は、マクロの名前です。Dim findCell As Range, firstCell As Range, targetRng As Rangeは、マクロ内で使用される変数を宣言します。findCellは検索中のセルを示し、firstCellは最初に見つかったセルを示し、targetRngは検索対象となる列を示します。Set targetRng = Columns("B")は、対象の列をB列に設定します。Set findCell = targetRng.Find(What:="*53*")は、検索語句*53*を含む最初のセルを見つけ、findCell変数に代入します。この部分で、検索対象の範囲はtargetRng変数で指定されます。If findCell Is Nothing Thenは、最初の検索で見つからなかった場合にエラーメッセージを表示するための条件分岐です。Set firstCell = findCellは、最初に見つかったセルをfirstCell変数に代入します。後で使用するためです。Doは、次のステップの開始を示すためのループの開始です。findCell.Interior.ThemeColor = msoThemeColorAccent4は、findCell変数が指すセルの背景色を変更するコードです。Set findCell = targetRng.FindNext(After:=findCell)は、次のfindCell変数を設定します。検索範囲はtargetRngで、前回見つかったセルの次のセルから検索が再開されます。Loop Until findCell.Address = firstCell.Addressは、最初のセルが見つかるまで、検索を繰り返すループです。検索範囲が最初のセルに戻った場合にループを終了します。searchResult.Interior.ColorIndex = 27は、見つかったすべてのセルの背景色を変更します。MsgBox Keyword & "：" & searchResult.Count & "件"は、検索語句と見つかったセルの数を表示します。MsgBox "完了"は、マクロの終了を示します。
検索ワード／カラー表示／セル／find
これは、指定されたキーワードを含むセルを検索し、該当するセルを強調表示するエクセルマクロです。
Sub ファインド_キーワード()
Dim Keyword As String
Dim FoundCell As Range
Dim firstFoundCell As Range
Dim searchResult As Range
'検索語句を指定
Keyword = "横浜"
FundCell = Cells.Find(What:=Keyword)
Set FoundCell = ActiveSheet.Range("A2:A1000").Find(What:=Keyword)
Set firstFoundCell = FoundCell
Set searchResult = FoundCell
Do
Set FoundCell = Cells.FindNext(FoundCell)
If FoundCell.Address = firstFoundCell.Address Then
Exit Do
Else
Set searchResult = Union(searchResult, FoundCell)
End If
Loop
searchResult.Interior.ColorIndex = 27
MsgBox Keyword & "：" & searchResult.Count & "件"
MsgBox "完了"
End Sub解説
- 変数の宣言
- 最初に、検索するキーワードを格納する変数(Keyword)、検索結果を格納するための変数(FoundCell, firstFoundCell, searchResult)を宣言しています。
- キーワードの指定
- 検索するキーワードを”横浜”として指定しています。
- キーワードの検索
- 次に、ActiveWorksheet内の”A2:A1000″の範囲内から、指定したキーワードを検索するためのFindメソッドを使用しています。
- 検索結果の取得
- Findメソッドにより、最初の検索結果が得られます。この結果をfirstFoundCell変数に格納し、次に検索されたセルが一巡して最初の検索結果に戻ってきた時点で検索を終了するまで、Do…Loop文を使用して検索を繰り返します。検索結果をsearchResult変数に追加していきます。
- 検索結果の強調表示
- searchResult変数に格納された検索結果のセルの内部を色付けして強調表示します。ここでは、インデックス27の色を使用しています。
- 結果の表示
- 最後に、検索したキーワードと該当するセルの数をメッセージボックスで表示します。
- 処理の完了
- 最後に、「完了」というメッセージボックスを表示して、処理を終了します。
検索ワード／カラー表示／行／find
このVBAコードは、指定された範囲内から特定の文字列を検索し、検索結果のセルを強調表示します。
Sub 検索行()
Dim 検索データ As Range
Dim 結果セル As Range
Dim 検索範囲 As Range
Dim 最初のアドレス As String
Dim LstRow1 As Long
LstRow1 = Worksheets("検索ﾃﾞｰﾀ").Range("A" & Rows.Count).End(xlUp).Row
Set 検索範囲 = ThisWorkbook.ActiveSheet.Columns(1)
Set 検索データ = ThisWorkbook.Worksheets("検索ﾃﾞｰﾀ").Range("A2:A" & LstRow1)
With 検索範囲
'初回検索はFindメソッド
Set 結果セル = .Find(What:=検索データ.Value)
If Not 結果セル Is Nothing Then
最初のアドレス = 結果セル.Address
Do
r = 結果セル.Address
Set 結果セル = .FindNext(結果セル)
Loop While Not 結果セル Is Nothing And 結果セル.Address <> 最初のアドレス
End If
End With
MsgBox "完了"
End Sub解説
- 「検索行()」というマクロの定義が始まる。
- 検索データ、結果セル、検索範囲、最初のアドレスの4つの変数を定義する。
- 「LstRow1 = Worksheets(“検索ﾃﾞｰﾀ”).Range(“A” & Rows.count).End(xlUp).Row」というコメントアウトされた行は、使用されないため、無視されます。
- 検索範囲に、アクティブシートの1列目を設定する。
- 検索データに、検索データシートのA列の2行目から最終行までの範囲を代入する。
- 以前コメントアウトされていた行「lastRow = Worksheets(“掲示板転記 (2)”).Range(“A” & Rows.count).End(xlUp).Row」は、使用されないため、無視されます。
- 検索範囲のFindメソッドを使用して、最初の検索を行い、結果セルに結果を代入する。
- 結果セルが空でない場合は、最初のアドレスに結果セルのアドレスを代入する。
- Do-Whileループを開始し、結果セルが見つからない場合かつ、結果セルのアドレスが最初のアドレスでない場合は、続行する。
- 結果セルのアドレスをrに代入し、FindNextメソッドを使用して次の検索を行う。
- ループは、結果セルが空でなく、かつ、結果セルのアドレスが最初のアドレスと異なる場合に繰り返されます。
- ループが完了したら、完了メッセージを表示します。
検索処理With 文を使って、検索範囲を指定します。Find メソッドを使って、検索データ を検索します。もし検索結果が見つかった場合、結果セル に検索結果のセルを設定します。FindNext メソッドを使って、次の検索結果を探索します。Do While ループで、検索結果がある限り、繰り返し処理を実行します。ループが終了したら、検索結果を強調する
コメント