Excel VBA – 循环search

首先，我的代码（如下）有效，但我试图看看是否可以简化。 这个代码所在的macros将有很多特定的search项目，我想尽可能地提高它的效率。

它正在search特定类别的logging（在本例中为“化学”），然后将这些logging复制到另一个工作簿中。 我觉得在search中使用Activate，在移动到下一个单元格时使用Select会花费太多的时间和资源，但是我不知道如何将它编码到不需要的地方。

具体细节如下：

• search栏T为“化学”
• 一旦find“化学”，将该行设置为“最高”logging。 例如A65
• 移到下一行，如果该单元格包含“化学”，移动到下一行（包含“化学”的单元格将全部在一起“
• 继续前进，直到找不到“化学”，然后向上移动一行
• 将该行设置为“底部”logging。 如AX128
• 结合顶部和底部的行来获得select的范围。 例如A65：AX128
• 复制该范围并将其粘贴到另一个工作簿中

这里是代码：

'find "Chemistry" Range("T1").Select Cells.Find(What:="Chemistry", After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ False, SearchFormat:=False).Activate 'set top row for selection toprow = ActiveCell.Row topcellselect = "A" & toprow 'find all rows for Chemistry Do While ActiveCell = "Chemistry" ActiveCell.Offset(1, 0).Select Loop ActiveCell.Offset(-1, 0).Select 'set bottom row for selection bottomrow = ActiveCell.Row bottomcellselect = "AX" & bottomrow 'define selection range from top and bottom rows selectionrange = topcellselect & ":" & bottomcellselect 'copy selection range Range(selectionrange).Copy 'paste into appropriate sheet wb1.Activate Sheets("Chemistry").Select Range("A2").PasteSpecial 

提前感谢任何帮助！

Answer 1

你永远不需要select或激活，除非这真的是你想要做的（在代码的末尾，如果你想让用户看到一定的范围select）。 要删除它们，只要取出激活和select，并把它们放在同一行。 例：

 wb1.Activate Sheets("Chemistry").Select Range("A2").PasteSpecial 

变

 wb1.Sheets("Chemistry").Range("A2").PasteSpecial 

整个代码 我只是回到专栏，看看它在哪里开始，并停止“化学”。 我把它放在一个小组，所以你只需要调用子，说你正在寻找哪个词，以及在哪里粘贴。

 Sub tester Call Paster("Chemistry", "A2") End sub Sub Paster(searchWord as string, rngPaste as string) Dim i as integer Dim startRange as integer , endRange as integer Dim rng as Range With wb1.Sheets("Chemistry") For i = 1 to .Cells(Rows.Count,20).End(XlUp).Row If .Range("T" & i ) = searchWord then 'Here it notes the row where we first find the search word startRange = i Do until .Range("T" & i ) <> searchWord i = i + 1 'Here it notes the first time it stops being that search word Loop endRange = i - 1 'Backtracking by 1 because it does it once too many times Exit for End if Next 'Your range goes from startRange to endRange now set rng = .Range("T" & startRange & ":T" & endRange) rng.Copy .Range(rngPaste).PasteSpecial 'Paste it to the address you gave as a String End with End sub 

正如你所看到的，我把这个长工作表引用放在一个With中来缩短它。 如果您有任何问题或者不能解决问题，请将其写入评论（我还没有testing过）

Answer 2

最有效的方法是创build一个临时自定义sorting顺序并将其应用到您的表中。

 Sub MoveSearchWordToTop(KeyWord As String) Dim DestinationWorkSheet As Workbook Dim SortKey As Range, rList As Range Set SortKey = Range("T1") Set rList = SortKey.CurrentRegion Application.AddCustomList Array(KeyWord) rList.Sort Key1:=SortKey, Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _ Orientation:=xlTopToBottom, DataOption1:=xlSortNormal Application.DeleteCustomList Application.CustomListCount Set DestinationWorkSheet = Workbooks("Some Other Workbook.xlsx").Worksheets("Sheet1") rList.Copy DestinationWorkSheet.Range("A1") End Sub