循环功能保持运行VBA Excel

Question

我需要你的帮助来让我的代码工作。

我做了一个代码，将单元格的值从一个表格复制到另一个表格，我需要在代码中复制所有值并在第一个值再次到达时停止。到现在为止还挺好。

但是，当我改变代码来寻找其他东西（例如“B”作为范围“2 X”）循环继续前进和粘贴在我的表中的值，并且不能停止。

下面是可用的代码。

因此，我需要一个相同的代码，但用不同的术语，我希望你们能帮助我。

Dim A As Range 
Sheet5.Activate 
Cells.Find(what:="1 X ", after:=ActiveCell, LookIn:=xlValues, lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:=False , searchformat:=False).Copy 
ActiveCell.Select 
Set A = ActiveCell 
Sheet75.Activate 
row_number = row_number + 1 
Cells(row_number, 2).Select 
ActiveCell.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False 
Do 
Blad5.Activate 
Cells.FindNext(after:=ActiveCell).Select 
Cells.FindNext(after:=ActiveCell).Copy 
Sheet75.Activate 
row_number = row_number + 1 
Cells(row_number, 2).Select 
ActiveCell.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False 
Loop Until ActiveCell.Value = A.Value 

谢谢你和srry的英语不好。

Answer 1

欢迎的话，请花一分钟取游：https://stackoverflow.com/tour

我也强烈建议您阅读评论共享的链接。

---

我改变了.Copy/.PasteSpecial这是非常缓慢的，因为你只想传输值，这是一个更快的方法！ ;）

下面是如何正确使用方法.Find：如果你想在停止查找（）包装回发现，那么你必须先比较细胞

Sub test_Steelbox() 
Dim FirstAddress As String, _ 
    cF As Range, _ 
    LookUpValue As String, _ 
    ShCopy As Worksheet, _ 
    ShPaste As Worksheet, _ 
    Row_Number As Double 

''Setup here 
Row_Number = 2 
LookUpValue = "2 X" 
Set ShCopy = ThisWorkbook.Sheets(Sheet5.Name) ''for example "data" 
Set ShPaste = ThisWorkbook.Sheets(Sheet75.Name) ''for example "summary" 

With ShCopy 
    .Range("A1").Activate 
    With .Cells 
     ''First, define properly the Find method 
     Set cF = .Find(What:=LookUpValue, _ 
        After:=ActiveCell, _ 
        LookIn:=xlValues, _ 
        LookAt:=xlPart, _ 
        SearchOrder:=xlByRows, _ 
        SearchDirection:=xlNext, _ 
        MatchCase:=False, _ 
        SearchFormat:=False) 

     ''If there is a result, do your data transfer and keep looking with FindNext method 
     If Not cF Is Nothing Then 
      FirstAddress = cF.Address 
      Do 
       ''This is much much faster than copy paste! 
       ShPaste.Cells(Row_Number, 2).Value = cF.Value 
       Row_Number = Row_Number + 1 

       Set cF = .FindNext(cF) 
      ''Loop until you find again the first result 
      Loop While Not cF Is Nothing And cF.Address <> FirstAddress 
     End If 
    End With 
End With 

End Sub