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
答案 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
在活动工作表上运行。 .Cells
对With
语句中指定的工作表进行操作。
注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
,则Activate
和With
之间的差异要小得多,但足以证明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
。只有一个Activate
或With
,性能没有明显变化。
宏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条目,则:
由于相同的单词可能会在目标范围内重复,因此目标范围的搜索必须检查每个单元格。但是,如果我们在目标范围内的每个条目中搜索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
这里要学习很多东西。慢慢来,查看任何你不理解的陈述。如有必要,请回答问题,但是你越了解自己,你的发展就越快。