循環功能保持運行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