Excel - 查找并替换多个单词

时间:2012-11-07 04:30:46

标签: excel excel-vba replace find vba

我只想对多个字符串进行简单的查找和替换。例如,我需要用“系统”替换所有“A1”,“A2”,“A3”,用“ACC”替换所有“B1”,“B2”等等......

有谁知道一条好的路线?我只是不确定如何开始这个。谢谢你的帮助!

1 个答案:

答案 0 :(得分:3)

最后更新迈克尔的评论为更多模式替换更好的方法

如果您使用Excel菜单中的手动Replace选项录制一个简单的宏,您将获得可以整理的代码

  1. 第一个选项会将ActiveSheet中包含"I am A1"的单元格更新为"I am System" - 部分字符串匹配
  2. 第二个选项只会更新ActiveSheet中仅包含"A1""Sytem"的单元格 - 即整个单元格字符串匹配
  3. <强>码

    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. 这两种方法是
      • 上面的Replace方法在循环中调用198次(即2 * 99)
      • RegExp \ variant数组合
    3. 在我的测试中,对于1,000,000个小区范围内的198个替换,第二种方法更快。

      少量替换会提高Replace的相对速度。更多关于RegExp 更多的细胞也会提高Replace的相对速度。减去RegExp

      我没有继续尝试使用Find方法来解析字符串。作为hyrbrid类型的解决方案( find 然后解析 ut将无法与单个替换解析竞争)

      <强>定时器

      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

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

      2)Regexp - Variant Array Sub

      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