見出し画像

マスターにあるキーワード番号があったらキーワードに置換するよ

この説明は、ChatGPTで作成しています。

このプロシージャは、Excel VBAを使って「マスター」シートにあるデータを元に、現在アクティブなシート内の特定の値を置き換える仕組みです。以下で、どのように動作するのかをわかりやすく説明します。


主な動作の流れ

  1. 「マスター」シートからデータを読み取る

    • 「マスター」という名前のシートを指定して、キーワード(番号と文字列)を配列に保存します。

    • 配列は「マスター」の2行目から最終行、1列目から最終列までのデータが対象です。

  2. アクティブなシートの検索範囲を設定

    • 現在作業中のシートで、A列からE列の2行目以降を検索範囲として設定します。

  3. 検索と置換のロジック

    • A2セルの内容が数字の場合と文字の場合で処理を分けています。

      • 数字の場合:「マスター」の1列目を検索し、該当するセルを2列目の内容に置換。

      • 文字の場合:「マスター」の2列目を検索し、該当するセルを1列目の内容に置換。

    • 該当するセルを見つけたら、そのセルの背景色を変更して目立たせます(数字の場合は青、文字の場合は黒)。

  4. 全ての置換が終わったら完了メッセージ

    • 「チェック完了!」というメッセージボックスが表示されます。


コードのポイント

  • 背景色を変える処理

    • FoundCell.Interior.Color を使ってセルの背景色を設定しています。数字の場合は青 (vbBlue)、文字の場合は黒 (vbBlack) になります。

  • 無限ループを防ぐ仕組み

    • Find メソッドを使った後に FindNext で次のセルを検索します。最初に見つけたセルに戻った場合、ループを終了する仕組みです。

  • ユーザビリティの配慮

    • 処理中に画面がちらつかないようにするため、Application.ScreenUpdating = False を使っています。


実際の使い方

  1. 「マスター」シートに、置換するキーワードの対応表を作成します。

    • 例: 1列目に番号、2列目に対応するキーワードを入力。

  2. 置換対象のシートをアクティブにして、このマクロを実行します。

  3. 置換後、背景色が変わっている部分を確認できます。


参考リンク

Sub マスタにあるキーワード番号があったらキーワードに置換するよ()
    Application.ScreenUpdating = False
    
    'マスターを配列に保存する
    Dim wsm As Worksheet
    Set wsm = Worksheets("マスター")
    Dim lastRow As Long, lastCol As Long
    lastRow = wsm.Cells(wsm.Rows.count, 1).End(xlUp).row
    lastCol = wsm.Cells(1, wsm.Columns.count).End(xlToLeft).Column

    Dim Master As Variant
    'マスターのテーブル範囲を設定(見出し含まず)
    Master = wsm.Range(wsm.Cells(2, 1), wsm.Cells(lastRow, lastCol)).Value
    
    Dim ws As Worksheet
    Set ws = ActiveSheet
    ws.Activate
    
    '検索範囲を制限(列15、行2以降)
    Dim SearchRange As Range
    Set SearchRange = ws.Range("A2:E" & ws.Cells(ws.Rows.count, 1).End(xlUp).row)
    
     ' A2セルの値でパターンを切り替える
    Dim isPattern1 As Boolean
    If IsNumeric(ws.Range("A2").Value) Then
        isPattern1 = True
    Else
        isPattern1 = False
    End If
    
    Dim FoundCell As Range, FirstCell As Range
    Dim i As Long
    For i = LBound(Master) To UBound(Master)
        If isPattern1 Then
            Set FoundCell = SearchRange.Find(What:=Master(i, 1))
            
            If FoundCell Is Nothing Then
                GoTo L1
            Else
                Set FirstCell = FoundCell
            End If
                    FoundCell.Value = Master(i, 2)
                    FoundCell.Interior.Color = vbBlue
            Do
                Set FoundCell = SearchRange.FindNext(FoundCell)
                If FoundCell Is Nothing Then
                    GoTo L1
                ElseIf FoundCell.Address = FirstCell.Address Then
                    GoTo L1
                End If
                FoundCell.Value = Master(i, 2)
                FoundCell.Interior.Color = vbBlue
            Loop
        Else
                Set FoundCell = SearchRange.Find(What:=Master(i, 2))
            
            If FoundCell Is Nothing Then
                GoTo L1
            Else
                Set FirstCell = FoundCell
            End If
                    FoundCell.Value = Master(i, 1)
                    FoundCell.Interior.Color = vbBlack
            Do
                Set FoundCell = SearchRange.FindNext(FoundCell)
                If FoundCell Is Nothing Then
                    GoTo L1
                ElseIf FoundCell.Address = FirstCell.Address Then
                    GoTo L1
                End If
                FoundCell.Value = Master(i, 1)
                FoundCell.Interior.Color = vbBlack
            Loop
        End If
L1:
    Next i
    MsgBox "チェック完了!"
    Application.ScreenUpdating = True
End Sub

ハッシュタグ

#excel #できること #vba #キーワード置換 #findメソッド #シート操作 #データ管理 #エクセル業務効率化 #配列処理 #背景色変更 #isnumeric関数 #msgbox #range設定 #セル検索 #excel初心者 #プロシージャ解説 #screenupdating #業務自動化 #vbaチュートリアル #findnext



English Translation of Explanation

Replace Keyword Numbers with Keywords if Present in Master

This explanation is created by ChatGPT.

This procedure uses Excel VBA to replace specific values in the currently active sheet based on data from a sheet named "Master." Here's an easy-to-understand explanation of how it works:


Main Workflow

  1. Read Data from the "Master" Sheet

    • The macro targets a sheet named "Master," saving keyword (number and text) data as an array.

    • The array includes data from row 2 to the last row and from column 1 to the last column.

  2. Define the Search Range in the Active Sheet

    • It sets columns A to E, starting from the second row onward, as the search range in the currently active sheet.

  3. Search and Replace Logic

    • The process differs based on whether cell A2 contains a number or text:

      • If A2 is a number: Search for values in column 1 of the "Master" sheet and replace them with the corresponding values from column 2.

      • If A2 is text: Search for values in column 2 of the "Master" sheet and replace them with the corresponding values from column 1.

    • It highlights replaced cells by changing their background color (blue for numbers, black for text).

  4. Completion Message

    • A message box saying "Check complete!" appears once all replacements are done.


Code Highlights

  • Changing Background Color

    • FoundCell.Interior.Color modifies the background color of cells (blue for numbers, black for text).

  • Preventing Infinite Loops

    • Using Find followed by FindNext ensures the loop stops once the search returns to the first found cell.

  • User-Friendly Design

    • The use of Application.ScreenUpdating = False prevents screen flickering during the process.


How to Use

  1. Create a correspondence table in the "Master" sheet:

    • Example: Enter numbers in column 1 and their corresponding keywords in column 2.

  2. Activate the target sheet and run the macro.

  3. After the replacement, review the highlighted cells.


Reference Links


Hashtags

#excel #automation #vba #keywordreplacement #findmethod #sheetoperations #datamanagement #excelproductivity #arrayprocessing #colorchange #isnumericfunction #msgbox #rangesetting #cellsearch #excelbeginners #procedureguide #screenupdating #taskautomation #vbatutorial #findnext

いいなと思ったら応援しよう!