在Excel工作表中替换多个单词

时间:2014-07-07 11:39:59

标签: excel-vba vba excel

Sub xLator2()
Dim s1 As Worksheet, s2 As Worksheet
Dim N As Long, i As Long
Dim from(), too()
Set s1 = Sheets("Sheet1") '   contains the data
Set s2 = Sheets("Sheet2") '   contains the translation table

s2.Activate

N = Cells(Rows.Count, 1).End(xlUp).Row
ReDim from(1 To N)
ReDim too(1 To N)
For i = 1 To N
    from(i) = Cells(i, 1).Value
    too(i) = Cells(i, 2).Value
Next i

s1.Activate

' -------------- Modification starts here --------------------------
' Replace from from(i) to __MYREPLACEMENTi__  (where i is the counter)
For i = LBound(from) To UBound(from)
    Cells.Replace What:=from(i), Replacement:="__MYREPLACEMENT" + Str(i) + "__"
Next i
' Replace from __MYREPLACEMENTi__ to too(i)  (where i is the counter)
For i = LBound(from) To UBound(from)
    Cells.Replace What:="__MYREPLACEMENT" + Str(i) + "__", Replacement:=too(i)
Next i
' -------------- Modification ends here --------------------------
End Sub

我正在使用上面的代码来查找和替换多个单词(在"列A Sheet1"在" B列表2"中有单词;)在下面提到的表格中:

https://docs.google.com/spreadsheets/d/14ba9pQDjMPWJd4YFpGffhtVcHxml0LdUUVQ0prrOEUY/edit?usp=sharing

然而,当我在另一张表格(如下所述)中将其应用于其他数据时,代码失败,即我在sheet1中得到扭曲的单词:

https://docs.google.com/spreadsheets/d/1spvZAzxT1kB1bytCQaNQH7tl1DJSpLITYgW6P5dxbQE/edit?usp=sharing

请帮帮我,以便我可以替换" A栏表1和#34;单词" B栏第2页"

注意:上面的链接已经提供了谷歌电子表格,但我在Excel 2007工作表中遇到了问题。

我请求你帮我提供全部修改后的代码,因为我不擅长VBA

1 个答案:

答案 0 :(得分:1)

我同意sous2817:你解决自己的问题越多,你的发展就越快。但是,我认为一些建议会有所帮助。

如果要使用VBA,您必须学习VBA。找到并尝试使用一段您不理解的代码永远不会结束。当这段代码的作者只知道比你更多的东西时,情况尤其如此。

在网上搜索" Excel VBA教程"。有很多可供选择,所以尝试一些,并完成一个符合您的学习风格。我更喜欢书。我参观了一个大型图书馆,审查了他们的Excel VBA Primers并借用了我喜欢的那些。在家里尝试之后,我买了最适合我的那个。

你从哪里得到这段代码?它包含典型的初学者错误,即使是第一个例子它也不起作用。

Sheet1中的第一个单词是"它"。 Sheet2表示"它"将由"替换为#34;。代码正确地替换了"它"通过"那"不幸的是,它取代了所有"它" s" s" s" with"被翻译为" wthath"没有"有"。既然你抱怨第二张纸,我猜你没注意到误译。在第二对中,这种误译必须更加明显,第一个词是""出现在"他们","那里","他们","他们","然后"和"这些"。

如果您查看Replace Method,您应该会看到此错误的快速更正。注意:Replace Method不是Replace Function

最后,我将举几个例子说明一个不那么初级的程序员如何编写这个例程。


考虑:

s2.Activate

N = Cells(Rows.Count, 1).End(xlUp).Row
ReDim from(1 To N)
ReDim too(1 To N)
For i = 1 To N
    from(i) = Cells(i, 1).Value
    too(i) = Cells(i, 2).Value
Next i

当您开始学习VBA时,您学到的第一件事就是“不要激活工作表或选择单元格”。这些是慢命令,即使您使用ScreenUpdating = False,也会有一些屏幕重写。更重要的是,您的代码可能会变得非常混乱。以下是更好的:

With s2

  N = .Cells(Rows.Count, 1).End(xlUp).Row
  ReDim from(1 To N)
  ReDim too(1 To N)
  For i = 1 To N
   from(i) = .Cells(i, 1).Value
   too(i) = .Cells(i, 2).Value
  Next i

End With

注1:三个Cells之前的时段。 Cells在活动工作表上运行。 .CellsWith语句中指定的工作表进行操作。

注2:我没有在Rows.Count之前放置一段时间。 Rows.Count返回活动工作表中的行数。 .Rows.Count返回指定工作表中的行数。行数取决于Excel的版本,并且不会因工作表和工作表而异,因此大多数程序员都不会对句点感到烦恼。


我会创建两个工作表参数:

Sub xLator2(s1 As Worksheet, s2 As Worksheet)

这使子程序更加灵活。我可能会更进一步,使参数范围更加灵活。


我可以继续,但我相信这已经足够了。祝你好运,欢迎来到编程的乐趣。


编辑:教程和完整解决方案

第1部分 - 不使用激活的一个原因

请研究以下代码块,这些代码块显示了为什么只有最低级的VBA程序员在没有充分理由的情况下才使用Activate。我不希望你在保存几秒或几毫秒时过于紧张。有些程序员会花半小时来优化只能一次又一次运行的例程。只有当一个例程每天运行数百次时才能证明这一点。我希望您了解Application.ScreenUpdating = False 可以节省大量时间,以便您自动使用它。如果包含Application.ScreenUpdating = False,则ActivateWith之间的差异要小得多,但足以证明With是默认选择。

  For Count = 1 To 10000             ' This takes 148 seconds
    Worksheets("Sheet1").Activate
    Worksheets("Sheet2").Activate
  Next

  Application.ScreenUpdating = False ' This takes 11 seconds
  For Count = 1 To 10000
    Worksheets("Sheet1").Activate
    Worksheets("Sheet2").Activate
  Next

  Application.ScreenUpdating = False ' This takes .07 seconds
  For Count = 1 To 10000
    With Worksheets("Sheet1")
    End With
    With Worksheets("Sheet2")
    End With
  Next

  Application.ScreenUpdating = False ' This takes 12 seconds
  For Count = 1 To 10000
    Worksheets("Sheet1").Activate
    Cells(23, 1).Value = "A"
    Worksheets("Sheet2").Activate
    Cells(23, 1).Value = "A"
  Next

  Application.ScreenUpdating = False ' This takes 1.16 seconds
  For Count = 1 To 10000
    With Worksheets("Sheet1")
      .Cells(23, 1).Value = "A"
    End With
    With Worksheets("Sheet2")
      .Cells(23, 1).Value = "A"
    End With
  Next

  Application.ScreenUpdating = False ' This takes 0.96 seconds
  Set Wsht1 = Worksheets("Sheet1")
  Set Wsht2 = Worksheets("Sheet2")
  For Count = 1 To 10000
    With Wsht1
      .Cells(23, 1).Value = "A"
    End With
    With Wsht2
      .Cells(23, 1).Value = "A"
    End With
  Next

第2部分 - 将值从工作表复制到数组

LoadFromTo1()基于宏的开始代码,它加载From和Too表。它略有不同,因为我的测试数据略有不同。加载From和Too表需要六分之一秒的时间

Sub LoadFromTo1()

  ' Takes about .594 seconds for 50,000 rows * 2 columns

  Dim s1 As Worksheet
  Dim N As Long, i As Long
  Dim From(), too()

  Dim InxFromTo As Long
  Dim TimeStart As Single

  TimeStart = Timer

  Set s1 = Sheets("Test1") '   contains the data

  s1.Activate

  N = Cells(Rows.Count, 3).End(xlUp).Row
  ReDim From(1 To N - 1)
  ReDim too(1 To N - 1)
  For i = 2 To N
    From(i - 1) = Cells(i, 3).Value
    too(i - 1) = Cells(i, 4).Value
  Next i

  Debug.Print "M1: " & Timer - TimeStart

  For InxFromTo = 1 To 20
    Debug.Print Right("    " & InxFromTo, 5) & " " & From(InxFromTo) & " " & too(InxFromTo)
  Next
  For InxFromTo = UBound(From) - 20 To UBound(From)
    Debug.Print Right("    " & InxFromTo, 5) & " " & From(InxFromTo) & " " & too(InxFromTo)
  Next

End Sub

LoadFromTo2()(未显示)使用With代替Activate。只有一个ActivateWith,性能没有明显变化。

LoadFromTo3()使用不同的技术来加载表。如果一次导入一个单元格值,则会在单个语句中导入:CellValue = .Range(.Cells(2, 3), .Cells(RowMax, 4)).Value。你现在可能觉得这个陈述很奇怪。但是,如果你学习和实践这项技术,它将成为第二天性。我发现LoadFromTo3()LoadFromTo1()更容易编码和理解,速度提高了十倍。我已经读过将一个范围作为一个单元而不是逐个单元格导入可以快五十倍,尽管我从未达到过这种性能提升水平。

Sub LoadFromTo3()

  ' Takes about .0625 seconds for 50,000 rows * 2 columns

  Const ColFrom As Long = 1
  Const ColTo As Long = 2

  Dim s1 As Worksheet
  Dim RowMax As Long, RowCrnt As Long

  Dim InxFromTo As Long
  Dim TimeStart As Single

  Dim CellValue As Variant

  TimeStart = Timer

  Set s1 = Sheets("Test1") '   contains the data

  With s1
    RowMax = .Cells(Rows.Count, 3).End(xlUp).Row
    CellValue = .Range(.Cells(2, 3), .Cells(RowMax, 4)).Value

    Debug.Print "M3: " & Timer - TimeStart

  End With

  For InxFromTo = 1 To 20
    Debug.Print Right("    " & InxFromTo, 5) & " " & CellValue(InxFromTo, ColFrom) & _
                                               " " & CellValue(InxFromTo, ColTo)
  Next
  For InxFromTo = UBound(CellValue, 1) - 20 To UBound(CellValue, 1)
    Debug.Print Right("    " & InxFromTo, 5) & " " & CellValue(InxFromTo, ColFrom) & _
                                               " " & CellValue(InxFromTo, ColTo)
  Next

End Sub

第3部分 - 原始代码分析

首先是一些定义。 目标范围是要翻译的单词列。 目标表是加载到内存中的目标范围。 FromTo范围是From和To列。 FromTo表是加载到内存中的FromTo范围。

此部分比我原先计划的时间更长。最初我只打算对我的代码进行适当的测试。由于早期答案中提供的代码中的错误以及暗示还​​有另一个错误,我特别小心。我编写了一个生成不同大小的测试数据的例程。我使用该例程生成我用于第2部分中的时间的50,000行FromTo表。我对您发布的翻译例程进行了一些小的更改,并根据我的测试数据运行它以提供以下持续时间:

FromTo  Target  Target  Duration  
  Rows    Rows    Cols   in secs
50,000      20       1       103
50,000  10,000       1       486
10,000   3,000       2        60

我修改过的代码的关键部分是:

With RngTgt
    For RowFromTo = 1 To UBound(FromToTable, 1)
      .Replace What:=FromToTable(RowFromTo, ColFrom), _
               Replacement:="__" + Str(RowFromTo), _
               LookAt:=xlWhole
    Next
    For RowFromTo = 1 To UBound(FromToTable, 1)
      .Replace What:="__" + Str(RowFromTo), _
               Replacement:=FromToTable(RowFromTo, ColTo), _
               LookAt:=xlWhole
    Next
  End With

我使用范围,因此目标范围可以在任何工作表中并且是多列的。我没有看到有这么大的前缀和后缀必须导致时间损失,所以我减少到两个下划线的前缀。我包括LookAt:=xlWhole更正。我使用从范围加载的ToFrom表。我已将i替换为有意义的名称RowFromTo,以使代码更易于理解。

没有评论说明这​​段代码的作用以及为什么会这样做。必须在宏中包含足够的注释。你会记得这个宏在六到十二个月里做了什么吗?如果同事需要修改它怎么办?

在你的第一个FromTo表中,"对于"转换为" on" " on"翻译"到"在"。没有两通解决方案。 "对于"可能会被翻译成" on"。这是我的猜测,这似乎是合理的,但应该有一个评论,所以我不需要猜测。一个负责这个宏的新程序员可能无法猜测,可能会改善"代码通过删除"不必要的"第二遍。

Replace方法背后的代码与其作者可以管理的效率一样高效,但它仍然需要检查范围内的每个单元格。我通过搜索指定的范围而不是整个工作表来改进了这种情况。但是,它仍然必须为FromTo表中的每一行搜索该范围两次。

研究这段代码我看到了立即的改进。第一遍用" __ 1"," __ 2"," __ n"替换目标表中的单词。等等,其中1,2和n是FromTo表的索引。第二遍搜索" __ 1"," __ 2"和" __ n"。更好的技术是提取1,2和n并使用它们来访问FromTo表中的正确条目。使用这种更好的技术,持续时间是:

                           First    Second
FromTo  Target  Target  duration  duration
  Rows    Rows    Cols   in secs   in secs
50,000      20       1       103        52
50,000  10,000       1       486       257
10,000   3,000       2        60        32

也就是说,我通过将代码更改为:

将持续时间减半
  With RngTgt
    For RowFromTo = 1 To UBound(ToFromTable, 1)
      .Replace What:=ToFromTable(RowFromTo, ColFrom), _
               Replacement:="__" + Str(RowFromTo), _
               LookAt:=xlWhole
    Next
  End With

  For Each Cell In RngTgt
    Test = Mid(Cell.Value, 3)
    If IsNumeric(Test) Then
      Cell.Value = ToFromTable(Val(Test), ColTo)
    End If
  Next

然而,我认为基本方法是错误的。如果FromTo范围中有FT条目,而目标范围中有T条目,则:

  • 使用方法1,有2 * FT替换需要搜索T细胞。
  • 使用方法2,有FT替换需要搜索T细胞,然后T替换。

由于相同的单词可能会在目标范围内重复,因此目标范围的搜索必须检查每个单元格。但是,如果我们在目标范围内的每个条目中搜索FromTo rangw的From列,该怎么办?除非目标范围中有大量单词从FromTo范围中丢失,否则将在找到匹配项之前检查平均FT / 2条目。也没有必要第二次通过。我们期望基于这种逻辑的第三种方法,到接近2种持续时间的一半。

我记录了我日常工作的主要部分并重复了测试

                           First    Second      Third
FromTo  Target  Target  duration  duration   duration
  Rows    Rows    Cols   in secs   in secs    in secs
50,000      20       1       103        52        .13
50,000  10,000       1       486       257      61.51 
10,000   3,000       2        60        32       7.54

这比我期望的持续时间大得多。我有一些猜测的原因,但我没有进一步调查。我相信最后的持续时间是可以接受的。我还有一个想法,但我认为不值得花时间去研究。

上面的主要教训是:在实施之前考虑一下你的实现startegy。对我而言,技术3明显优于技术1和2,我将从这种技术开始。花在初始设计上的一些时间可以很好地回报。

第4部分 - 最终解决方案

您发布了两个工作簿,每个工作簿都包含Sheet1中的目标范围和Sheet2中的FromTo范围。我创建了一个工作簿,将第二个工作簿中的数据复制到Sheet3和Sheet3。

我修改了你的宏来调用我的宏:

Option Explicit
Sub xLator2()

  Dim RngTgt As Range
  Dim RngFromTo As Range
  Dim RowMax As Long
  Dim TimeStart  As Single

  With Worksheets("Sheet1")
    RowMax = .Cells(Rows.Count, "A").End(xlUp).Row
    Set RngTgt = .Range(.Cells(1, "A"), .Cells(RowMax, "A"))
  End With

  With Worksheets("Sheet2")
    RowMax = .Cells(Rows.Count, "A").End(xlUp).Row
    Set RngFromTo = .Range(.Cells(1, "A"), .Cells(RowMax, "B"))
  End With

  TimeStart = Timer
  Call Translate3(RngTgt, RngFromTo)
  Debug.Print "Sheet1 technique 3 duration: " & Timer - TimeStart

  With Worksheets("Sheet3")
    RowMax = .Cells(Rows.Count, "A").End(xlUp).Row
    Set RngTgt = .Range(.Cells(1, "A"), .Cells(RowMax, "A"))
  End With

  With Worksheets("Sheet4")
    RowMax = .Cells(Rows.Count, "A").End(xlUp).Row
    Set RngFromTo = .Range(.Cells(1, "A"), .Cells(RowMax, "B"))
  End With

  TimeStart = Timer
  Call Translate3(RngTgt, RngFromTo)
  Debug.Print "Sheet3 technique 3 duration: " & Timer - TimeStart

End Sub

我的技术3的宏需要两个范围作为参数,因此可以有多个Target和FromTo范围,可以放在哪里方便:

Sub Translate3(ByVal RngTgt As Range, ByVal RngFromTo As Range)

  ' RngTgt     A rectangle containing words to be translated
  ' RngFromTo  Two columns with the left column containing the original values
  '            for words and the right column containing the values to replace
  '            the original values.

  ' Constants numbering the From and To columns within RngFromTo.  This makes the
  ' code easier to understand than if 1 and 2 had been used.
  Const ColFrom As Long = 1
  Const ColTo As Long = 2

  Dim ColTgtCrnt As Long
  Dim Test As String
  Dim RngFindStart As Range
  Dim RngFrom As Range
  Dim RngTemp As Range
  Dim RowFromTo As Long
  Dim RowTgtCrnt As Long
  Dim TgtTable As Variant

  ' Check FromTo range has two columns
  If RngFromTo.Columns.Count <> 2 Then
    Call MsgBox("ToFrom table must have two columns", vbOKOnly)
    Exit Sub
  End If

  ' Load Target range to array
  TgtTable = RngTgt.Value

  ' Set RngFrom to the From column of RngFromTo
  Set RngFrom = RngFromTo.Columns(ColFrom)
  ' Set RngFindStart to first cell of RngFrom
  Set RngFindStart = RngFrom.Rows(1)

  ' Loop for every entry in Target table
  For RowTgtCrnt = 1 To UBound(TgtTable, 1)
    For ColTgtCrnt = 1 To UBound(TgtTable, 2)
      Set RngTemp = RngFrom.Find(What:=TgtTable(RowTgtCrnt, ColTgtCrnt), _
                                 After:=RngFindStart, _
                                 LookAt:=xlWhole)
      If Not RngTemp Is Nothing Then
        ' This target cell is to be translated
        ' Replace value in Target table with value for To column of FromTo table
        TgtTable(RowTgtCrnt, ColTgtCrnt) = RngTemp.Offset(0, ColTo - ColFrom).Value
      End If
    Next
  Next

  ' Upload updated array back to Target range
  RngTgt.Value = TgtTable

End Sub

这里要学习很多东西。慢慢来,查看任何你不理解的陈述。如有必要,请回答问题,但是你越了解自己,你的发展就越快。