vba - 循环函数保持运行VBA Excel

Question

我需要你的帮助才能让我的代码正常运行。

我编写了一个代码将单元格的值从一张纸复制到另一张纸，我需要在代码中使用一个循环来复制所有值并在再次到达第一个值时停止。到目前为止，一切都很好。

但是当我更改代码以查找其他内容(例如“2 X”，其中 B 作为范围)时，循环会继续进行并将值粘贴到我的工作表中，并且无法停止。

下面是有效的代码。

所以我需要一个具有相同功能但具有不同术语的代码，我希望你们能帮助我。

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 

谢谢你，抱歉英语不好。

Answer 1

欢迎来到SO，请花一点时间参观: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