循环函数持续运行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 

谢谢您，并对我的英语不好感到抱歉。

- Steelbox

---

如果您想在Find()返回到第一个找到的单元格时停止，则必须比较“.Address”范围属性而不是“.Value”属性。 - user3598756

你的代码中有很多.Select和.Activate，你可能需要查看如何避免使用Select。 - Vincent G

你需要观看以下两个有关Excel VBA的视频教程：Excel VBA入门第5部分-选择单元格（Range、Cells、Activecell、End、Offset）和Excel VBA入门第15a部分-查找和查找下一个。 - user6432984

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

- R3uK

---

@Steelbox：显然你没有参观过，否则你就会知道如果答案解决了你的问题，你可以/应该/必须接受它。请花一分钟时间了解这个社区是如何运作的！;) - R3uK