excel - Excel-複数の単語を検索して置換

Question

複数の文字列を簡単に検索して置換したいだけです。たとえば、すべての「A1」、「A2」、「A3」を「system」に置き換え、すべての「B1」、「B2」を「ACC」に置き換える必要があります。

誰かが取るのに良いルートを知っていますか？これを開始する方法がわかりません。助けてくれてありがとう！

Answer 1

マイケルのコメントに対処する下部の更新は、多くのパターン置換のためのより良いアプローチです

Excelメニューの手動Replaceオプションを使用して単純なマクロを記録すると、これまで整理できるコードが得られます

1. ActiveSheet最初のオプションは、含むよりもセルを更新します"I am A1"-"I am System"部分文字列の一致
2. 2番目のオプションは、にのみをActiveSheet含むセルのみを更新します-つまり、セル文字列全体が一致します"A1""Sytem"

コード

Sub UpdatePartial()
With ActiveSheet.UsedRange
.Replace "A1", "System", xlPart
.Replace "A2", "System", xlPart
.Replace "A3", "System", xlPart
.Replace "B1", "ACC", xlPart
.Replace "B2", "ACC", xlPart
End With
End Sub

Sub UpdateWhole()
With ActiveSheet.UsedRange
.Replace "A1", "System", xlWhole
.Replace "A2", "System", xlWhole
.Replace "A3", "System", xlWhole
.Replace "B1", "ACC", xlWhole
.Replace "B2", "ACC", xlWhole
End With
End Sub

アップデート

以下のコード

1. 基本を使用して、からの範囲のすべての部分Timer文字列の置換を比較しますA1-A99B1-B99
2. 2つの方法は
   • 上記のReplaceメソッドは、ループ内で198回（つまり2 * 99）呼び出されました
   • \バリアントRegExp配列コンボ

私のテストでは、2番目の方法は1,000,000セル範囲での198回の置換の方が高速です。

交換が少ないほど、への相対速度が向上しReplaceます。より多くのセルに向かってRegExp より多くはまたに向かって相対速度を改善しReplaceます。に向かって少ないRegExp

Find後で文字列を解析するメソッドの試行は続行しませんでした。hyrbridタイプのソリューションとして（検索してから解析することは、単一の置換または解析に対して競合しません）

タイマー

Sub MainCaller()
Dim dbTime As Double
Dim lngCnt As Long

dbTime = Timer()
For lngCnt = 1 To 99
Call UpdatePartial("A" & lngCnt, "System")
Call UpdatePartial("B" & lngCnt, "System")
Next lngCnt
Debug.Print Timer() - dbTime
dbTime = Timer()
Call RegexReplace("(A|B)[1-99]", "System")
Debug.Print Timer() - dbTime
End Sub

1）サブを交換してください

Sub UpdatePartial(StrIn As String, StrOut As String)
ActiveSheet.UsedRange.Replace StrIn, StrOut, xlPart
End Sub    

2）正規表現-バリアント配列サブ

Sub RegexReplace(StrIn As String, StrOut As String)
    Dim rng1 As Range
    Dim rngArea As Range
    Dim lngRow As Long
    Dim lngCol As Long
    Dim lngCalc As Long
    Dim objReg As Object
    Dim X()


    'On Error Resume Next
    'Set rng1 = Application.InputBox("Select range for the replacement of leading zeros", "User select", Selection.Address, , , , , 8)
    'If rng1 Is Nothing Then Exit Sub
    'On Error GoTo 0

    ActiveSheet.UsedRange
    Set rng1 = ActiveSheet.UsedRange

    'See Patrick Matthews excellent article on using Regular Expressions with VBA
    Set objReg = CreateObject("vbscript.regexp")
    With objReg
    .Pattern = StrIn
    .ignorecase = False
    .Global = True
    End With

   'Speed up the code by turning off screenupdating and setting calculation to manual
   'Disable any code events that may occur when writing to cells
    With Application
        lngCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With

    'Test each area in the user selected range

    'Non contiguous range areas are common when using SpecialCells to define specific cell types to work on
    For Each rngArea In rng1.Areas
        'The most common outcome is used for the True outcome to optimise code speed
        If rngArea.Cells.Count > 1 Then
           'If there is more than once cell then set the variant array to the dimensions of the range area
           'Using Value2 provides a useful speed improvement over Value. On my testing it was 2% on blank cells, up to 10% on non-blanks
            X = rngArea.Value2
            For lngRow = 1 To rngArea.Rows.Count
                For lngCol = 1 To rngArea.Columns.Count
                    'replace the leading zeroes
                    X(lngRow, lngCol) = objReg.Replace(X(lngRow, lngCol), StrOut)
                Next lngCol
            Next lngRow
            'Dump the updated array back over the initial range
            rngArea.Value2 = X
        Else
            'caters for a single cell range area. No variant array required
            rngArea.Value = objReg.Replace(rngArea.Value, StrOut)
        End If
    Next rngArea

    'cleanup the Application settings
    With Application
        .ScreenUpdating = True
        .Calculation = lngCalc
        .EnableEvents = True
    End With

    Set objReg = Nothing
End Sub