マスタに登録した略語があったら赤字にして正式名称を隣列にだすよ

makotoym

2025年1月5日 07:00

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

このVBAコードは、Excelシート内で「略語」を検索し、略語が見つかった場合はその略語を赤字にし、隣の列にその略語の正式名称を表示するものです。また、略語がどのくらい使われたかの記録も管理します。

動作の仕組み：

略語マスタの読み込み
「略語マスタ」という名前のシートにある略語と正式名称を、プログラムの中で使えるように配列に保存します。このシートでは以下の情報が必要です：
- 列1: 略語
- 列2: 正式名称
- 列3: 使用回数（任意）
- 列4: 最終使用日（任意）
略語の検索範囲設定
操作対象のシート（現在アクティブなシート）のA列（2行目以降）を検索範囲として設定します。
略語の検索と書式設定
検索範囲から略語を探し、以下を実行します：
- 略語の文字を赤字にする（赤色のカラーインデックス：3）。
- 略語の隣のセルに正式名称を記載する。複数の正式名称がある場合はカンマで区切って追記します。
- マスタシートで該当略語の使用回数をカウントアップし、最終使用日を更新します。
処理の終了
処理完了後に、メッセージボックスで「チェック完了！」と表示します。

使い方：

「略語マスタ」という名前のシートを用意し、略語と正式名称を入力しておきます。
略語が含まれるデータを対象のシート（A列）に配置します。
このマクロを実行すると、自動的に略語が赤字になり、隣の列に正式名称が表示されます。

注意点：

このマクロを実行する前に「略語マスタ」シートと検索対象のシートが正しく設定されているか確認してください。
データ量が多い場合は処理に時間がかかることがあります。

参考リンク：

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
    
    '検索範囲を制限（列1、行2以降）
    Dim SearchRange As Range
    Set SearchRange = ws.Range("A2:A" & ws.Cells(ws.Rows.count, 1).End(xlUp).Row)
    

    Dim FoundCell As Range, FirstCell As Range
    Dim i As Long
    For i = LBound(Master) To UBound(Master)
            Dim i2 As Long
            Dim myStr As String

            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)
                    
                    For i2 = 1 To Len(FoundCell.Value)
                        myStr = Mid(FoundCell.Value, i2, Len(Master(i, 1)))
                        If myStr Like Master(i, 1) Then
                            With FoundCell.Characters(Start:=i2, Length:=Len(Master(i, 1))).Font
                                .ColorIndex = 3
                            End With
                        End If
                    Next i2
                    If FoundCell.Offset(0, 1) = "" Then
                        FoundCell.Offset(0, 1) = Master(i, 2)
                    Else
                        FoundCell.Offset(0, 1) = FoundCell.Offset(0, 1).Value & "," & Master(i, 2)
                    End If
                    Master(i, 3) = Master(i, 3) + 1
                    Master(i, 4) = Date
                    
            Do
                Set FoundCell = SearchRange.FindNext(FoundCell)
                If FoundCell Is Nothing Then
                    GoTo L1
                ElseIf FoundCell.Address = FirstCell.Address Then
                    GoTo L1
                End If
                For i2 = 1 To Len(FoundCell.Value)
                        myStr = Mid(FoundCell.Value, i2, Len(Master(i, 1)))
                        If myStr Like Master(i, 1) Then
                            With FoundCell.Characters(Start:=i2, Length:=Len(Master(i, 1))).Font
                                .ColorIndex = 3
                            End With
                        End If
                    Next i2
                    
                    If FoundCell.Offset(0, 1) = "" Then
                        FoundCell.Offset(0, 1) = Master(i, 2)
                    Else
                        FoundCell.Offset(0, 1) = FoundCell.Offset(0, 1).Value & "," & Master(i, 2)
                    End If
                    Master(i, 3) = Master(i, 3) + 1
                    Master(i, 4) = Date
            Loop

L1:
    Next i
    
    'マスタの上書き
    wsm.Range(wsm.Cells(2, 1), wsm.Cells(lastRow, lastCol)).Value = Master
    
    MsgBox "チェック完了！"
    Application.ScreenUpdating = True
End Sub

キーワード：

#excel #できること #vba #略語検索 #赤字設定 #正式名称 #配列 #検索範囲 #セルフォーマット #データ管理 #自動化 #検索機能 #カウントアップ #マクロ #効率化 #セル操作 #エラー処理 #色変更 #文字列検索

English Explanation:

Highlight Abbreviations in Red and Output Formal Names to the Adjacent Column

This explanation is created by ChatGPT.

This VBA code is designed to search for abbreviations in an Excel sheet. If an abbreviation is found, the code highlights it in red and displays its corresponding formal name in the adjacent column. Additionally, it tracks the usage count and the last usage date for each abbreviation.

How it works:

Load the Abbreviation Master:
The code reads a "Abbreviation Master" sheet containing abbreviations and their formal names into an array. The sheet structure includes:
- Column 1: Abbreviation
- Column 2: Formal Name
- Column 3: Usage Count (optional)
- Column 4: Last Used Date (optional)
Define Search Range:
It identifies the search range in column A (starting from row 2) of the currently active sheet.
Search and Apply Formatting:
For each abbreviation in the master:
- Highlights the abbreviation in red text.
- Adds its formal name to the adjacent cell. If there are multiple formal names, they are appended with a comma separator.
- Updates the usage count and the last usage date in the master sheet.
Completion Notification:
After the operation, a message box displays "Check Complete!"

How to Use:

Prepare the "Abbreviation Master" sheet with abbreviations and their formal names.
Populate column A of the target sheet with data containing abbreviations.
Run the macro to process the data. The abbreviations will be highlighted in red, and their formal names will appear in the adjacent column.

Notes:

Ensure the "Abbreviation Master" and the target sheet are properly set up before running the macro.
Processing time may increase for large datasets.

References:

Keywords: #excel #vba #automation #abbreviationsearch #redtext #formalname #array #searchrange #cellformat #datamanagement #automationtool #searchfeature #usagecount #macro #optimization #celloperation #errorhandling #textcolorchange #stringsearch

マスタに登録した略語があったら赤字にして正式名称を隣列にだすよ

Highlight Abbreviations in Red and Output Formal Names to the Adjacent Column

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