루프 기능이 계속 VBA Excel

Question

내 코드를 작동 시키려면 도움이 필요합니다.

한 시트에서 다른 시트로 셀 값을 복사하는 코드를 만들었습니다. 모든 값을 복사하고 첫 번째 값이 다시 도달하면 코드의 루프가 필요했습니다. 여태까지는 그런대로 잘됐다.

그러나 다른 것들 (예 : "2 X"범위로 B) 찾기 위해 코드를 변경하면 루프 내 시트에 값을 계속 및 붙여 넣기 및 stopt 수 없습니다.

아래 코드는 작동합니다.

그래서 같은 용어를 사용하는 코드가 필요합니다. 여러분이 저를 도울 수 있기를 바랍니다.

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

오신 것을 환영합니다, 그래서 여행을하는 분을하시기 바랍니다 : 나는 또한 강력하게 의견 공유의 링크를 읽어 볼 것을 조언 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