Question

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

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

但是当我改变代码以找到其他东西时（例如＆＃34; 2 X＆＃34; 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

循环函数继续运行VBA Excel

1 个答案: