Question

任何替代方案或建议，以加强下面陈述的代码，在多个条件下找到单元格并将其粘贴到另一张纸上。

Sub test()
  'For Move Entire Row to New Worksheet if Cell Contains Specific Text's
  'Using autofilter to Copy rows that contain certain text to a sheet called commodity
  Dim LR As Long
  Range("A2").EntireRow.Insert Shift:=xlDown
  LR = Sheets("Data").Cells(Rows.Count, "E").End(xlUp).Row
  LR1 = Sheets("Commodity").Cells(Rows.Count, "A").End(xlUp).Row + 1

  With Sheets("Data").Range("e:e")
    .AutoFilter Field:=1, Criteria1:=("*SILVER*")
    .SpecialCells(xlCellTypeVisible).EntireRow.Copy 
    Destination:=Sheets("Commodity").Range("A" & LR1)
    .SpecialCells(xlCellTypeVisible).EntireRow.Delete
  End With

  With Sheets("Data").Range("e:e")
    .AutoFilter Field:=1, Criteria1:=("*GOLD*")
    .SpecialCells(xlCellTypeVisible).EntireRow.Copy 
    Destination:=Sheets("Commodity").Range("A" & LR1)
    .SpecialCells(xlCellTypeVisible).EntireRow.Delete
  End With

  With Sheets("Data").Range("e:e")
    .AutoFilter Field:=1, Criteria1:=("*MCX*")
    .SpecialCells(xlCellTypeVisible).EntireRow.Copy 
    Destination:=Sheets("Commodity").Range("A" & LR1)
    .SpecialCells(xlCellTypeVisible).EntireRow.Delete
  End With

End Sub

Answer 1

除了@ShaiRado正在提出的好建议之外，还有什么因为你重复与Excel功能和界面的交互而减慢了。理想情况下，您将数据读入VBA中的变量，然后，在VBA内，检查匹配并准备输出数组。这样，您只需要在VBA和Excel之间进行一次交互，即将输出数组写入目标工作表。一次删除一行也很费时，所以你可能最好只创建一个“删除范围”并一次性完成所有操作。

下面给出了实现此目的的骨架代码（但请注意，如果您使用的范围不是从“A”开始，则需要'列偏移'计算，并且您可能选择比{{1}更可靠的函数}）。你可以像这样调用例程：

UsedRange

例程本身可能会像这样：

TransferData "Silver", "Gold", "MCX"

在多个条件下查找单元格并将其粘贴到另一个工作表（简体）

1 个答案: