web-dev-qa-db-ja.com

選択したセル内の複数の値を検索して置換する

Excelの範囲内の複数の値に対して2列の値で検索と置換を実行したい：Aは元のWordで、翻訳付きのB。これを50％動作させるVBAコードを既に見つけましたが、このコードはworskheet全体で実行します。

理想的には、選択した範囲のみで実行できるようにしたいと考えています。追加のボーナスは、ルックアップ範囲も選択できる場合です。

これは私がこれまで使ってきたものです。ご協力いただきありがとうございます！

Sub abbrev()
            Dim abvtab() As Variant
            Dim ltsheet As Worksheet
            Dim datasheet As Worksheet
            Dim lt As Range

            'Change Lookup to the sheet name with your lookup table.
            Set ltsheet = Sheets("Lookup")

            'Change Data to the sheet name with your data.
            Set datasheet = Sheets("Data")

            'Change A2 to the top left cell (not the header) in your lookup table.
            'Change B2 to top right cell.
            Set lt = ltsheet.Range("A1", ltsheet.Range("B1").End(xlDown))

            abvtab = lt

            For i = 1 To UBound(abvtab)
                datasheet.Cells.Replace What:=abvtab(i, 1), Replacement:=abvtab(i, 2), LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
                    ReplaceFormat:=False
            Next i
End Sub
microsoft-excelmacrosvba
6
WouterB

Excelマルチ置換

  1. VBAエディター（Alt+F11）以下のマクロをどこかに貼り付けます
  2. 2列のルックアップ範囲を設定します。1列目は検索する値、2列目は置換する値です
  3. 選択最初の図に示すように値を置き換える入力範囲
  4. マクロを実行（Alt+F8）。

マクロは、検索範囲がどこにあるかを尋ねます。最初にシート名、次にルックアップ範囲アドレス。最初の列のみを入力してください。例：A1:A2以下の例をご覧ください。

それでおしまい。これで、マクロはすべての置換ルールを反復し始め、それらを
通常のExcel検索と置換（Ctrl+H）選択した入力範囲に。

Input range            Replace rules               Input range after macro

enter image description hereenter image description hereenter image description here

Sub MultiReplace()
On Error GoTo errorcatch
Dim arrRules() As Variant

    strSheet = InputBox("Enter sheet name where your replace rules are", _
        "Sheet name", "Sheet1")
    strRules = InputBox("Enter address of replaces rules." & vbNewLine & _
        "But only the first column!", "Address", "A1:A100")

    Set rngCol1 = Sheets(strSheet).Range(strRules)
    Set rngCol2 = rngCol1.Offset(0, 1)
    arrRules = Application.Union(rngCol1, rngCol2)

    For i = 1 To UBound(arrRules)
        Selection.Replace What:=arrRules(i, 1), Replacement:=arrRules(i, 2), _
            LookAt:=xlWhole, MatchCase:=True
    Next i

errorcatch:
End Sub
4
nixda