ループ機能がVBA Excelを実行し続ける

Question

私のコードを動作させるにはあなたの助けが必要です。

1つのシートから別のシートにセルの値をコピーするコードを作ったので、すべての値をコピーして最初の値に達したときに停止するコードがループに必要でした。ここまでは順調ですね。

しかし、私は他のものを見つけるためにコードを変更すると（例として "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 

ありがとう、悪い英語のためにsrry。

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