"WHILE"がExcel VBAマクロで最初に実行された後に壊れています

Question

FOR内のWHILE内でIFを実行しようとしています。 FORとIFは、想定されているように動作しています。しかし、最初の成功の後にWHILEを実行し、それが再びWHILEから戻って来るのは、一度しか流れず、残りの行を調べません。ここでは、コードです：

'COPY EACH PO TO ITS OWN SHEET ............................................ 

    'set the sequence variable 
    For x = 1 To 50 

    Dim LSearchRow, LCopyToRow As Integer 

    'Start search in row 1 
    LSearchRow = 2 

    'Start copying data to row 2 in PO40 (row counter variable) 
    LCopyToRow = 2 

    'run the copy script for each PO 
    While Len(Range("C" & CStr(LSearchRow)).Value) > 0 

     'If value in column H = "sequence match", copy entire row to its particular sheet 
     If Range("H" & CStr(LSearchRow)).Value = x Then 

     'Select row in Sheet1 to copy 
     Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select 
     Selection.Copy 

     'Paste row into its particular sheet in next row 
     sheets("PO" & x).Select 
     Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select 
     ActiveSheet.Paste 

     'Move counter to next row 
     LCopyToRow = LCopyToRow + 1 

     End If 

     LSearchRow = LSearchRow + 1 

     sheets(1).Select 
     Application.CutCopyMode = False 

    Wend 

     sheets("PO" & x).Select 
     Cells.Select 
     Cells.EntireColumn.AutoFit 

    Next x 

Answer 1

・ホープ、この作品は

Sub pos() 

For x = 1 To 50 

    Dim LSearchRow, LCopyToRow As Integer 

    LSearchRow = 2 
    LCopyToRow = 2 

    While Cells(LSearchRow, 3) <> "" 

     If Cells(LSearchRow, 8) = x Then 
     For j = 1 To 8 
      Sheets("PO" & x).Cells(LCopyToRow, j) = Sheets(1).Cells(LSearchRow, j) 
     Next 
     End If 

     LSearchRow = LSearchRow + 1 
     LCopyToRow = LCopyToRow + 1 

    Wend 

    Next x 

End Sub 

Answer 2

もともとあなたはシートを選択するので、それはすることができた（1）が、後に自分のWhileループ内で、あなたは「（シートを使用していますPO "& x）を選択します。フォーカスが新しいシートに切り替わり、whileループ条件で探しているデータが表示されないことがあります。

実際のファイルを見ることなく、これは単なる推測です。

Answer 3

私は本当にあなたの "議論"に従っていませんし、確かに介入したくありません。上記のコードにはより多くの選択がない@dpdragnevによって示唆されるように

1. ：

   Public Sub tmpSO() 
   
   Dim LSearchRow As Long, LCopyToRow As Long 
   Dim shtSource As Worksheet, shtTarget As Worksheet 
   Dim bolFound As Boolean 
   
   Set shtSource = ThisWorkbook.Worksheets("Sheet1") 'Name of the source sheet 
   
   'set the sequence variable 
   For x = 1 To 50 
       'Verify the existence of a sheet before processing it... 
       bolFound = False 
       For Each shtTarget In ThisWorkbook.Worksheets 
        If shtTarget.Name = "PO" & x Then 
         bolFound = True 
         Exit For 
        End If 
       Next shtTarget 
       If bolFound = False Then 
        MsgBox "Couldn't find target sheet PO" & x & Chr(10) & "Skipping... moving on to next sheet." 
        GoTo NextSheet 
       End If 
   
       'Start search in row 1 
       LSearchRow = 2 
   
       'Start copying data to row 2 in PO40 (row counter variable) 
       LCopyToRow = 2 
   
       'run the copy script for each PO 
       While Len(shtSource.Cells(LSearchRow, "C").Value) > 0 
   
        'If value in column H = "sequence match", copy entire row to its particular sheet 
        If shtSource.Cells(LSearchRow, "H").Value = x Then 
   
         'Select row in Sheet1 to copy 
         shtSource.Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Copy 
   
         'Paste row into its particular sheet in next row 
         shtTarget.Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Paste 
   
         Application.CutCopyMode = False 
         'Move counter to next row 
         LCopyToRow = LCopyToRow + 1 
   
        End If 
   
        LSearchRow = LSearchRow + 1 
   
       Wend 
   
       shtTarget.Cells.EntireColumn.AutoFit 
   NextSheet: 
   
   Next x 
   
   End Sub 
   

   注：まだ、私はあなたの問題に役立つかもしれないいくつかの変更を提案する衝動を感じました。

2. 明示的なコーディングは、あなたが参照しているシートを明記せずにActiveSheetまたはRangeを使用するだけではないことを意味します。
3. Range("H" & CStr(LSearchRow))のほんの厄介な用途がありましたが、これをCells(LSearchRow, "H")に変更しました。私はこれをもっと読みやすくすると信じており、よりも速くなると私はCellsを知っています。
4. Dimはx-loopの外側に移動しました。何度も何度も何度もDimする必要はありません。
5. Dimに複数の変数を使用する場合、変数を変数ごとに繰り返す必要があります。したがって、Dim LSearchRow, LCopyToRow As Integerの代わりにDim LSearchRow as Integer, LCopyToRow As Integerと書く必要があります。
6. Integerは今のところうまくいくと思います。しかし、最終的には（Excelの行を扱う場合）、32,000（と何か）の行を超える可能性があります。だから、おそらくLongと一緒に行く方が良いでしょう。
7. シートを処理する前にシートが存在することを確認するために、xループの先頭に小さな「余分な」余白が追加されました。

それ以外は、今は何も見つかりませんでした。もちろん、改善できるものがたくさんあります。しかし、私はあまりにもあなたのコードを変更したくなかった。あなたは2人がそれに多くの労力をかけました。

_{上記のコードはであり、はテストされていません。私は頭の上からそれを書いただけで、いくつかの調整が必要な欠陥が含まれている可能性があります。この場合、私にそれについてお気軽にお問い合わせください。}

Answer 4

@ Ralphのコードを変更して動作させました。私は書かれているように貼り付けを得ることができませんでしたが、古いコードから調整し、それは魅力のように動作します。次のように動作するコードは... @Ralph、ここに掲載@dpdragnevと@csanjoseへ

Dim LSearchRow As Long, LCopyToRow As Long 
Dim shtSource As Worksheet 

Set shtSource = sheets(1) 'source sheet 

'set the sequence variable 
For x = 1 To 50 

    'Start search in row 1 
    LSearchRow = 2 

    'Start copying data to row 2 in PO40 (row counter variable) 
    LCopyToRow = 2 

    'run the copy script for each PO 
    While Len(shtSource.Cells(LSearchRow, "C").Value) > 0 

     'If value in column H = "sequence match", copy entire row to its particular sheet 
     If shtSource.Cells(LSearchRow, "H").Value = x Then 

      'Select row in first sheet to copy 
      shtSource.Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Copy 

      'Paste row into its particular sheet in next row 
      sheets("PO" & x).Select 
      Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select 
      ActiveSheet.Paste 

      Application.CutCopyMode = False 
      'Move counter to next row 
      LCopyToRow = LCopyToRow + 1 

     End If 

     LSearchRow = LSearchRow + 1 

    Wend 
     Cells.Select 
     Cells.EntireColumn.AutoFit 

Next x 

おかげで成功します！