在Excel VBA宏中首次运行后，“ WHILE”被破坏

Question

我正在尝试在FOR中的WHILE中运行IF。 FOR和IF的工作如预期的那样。 但是在第一次成功运行WHILE之后，它又从FOR中返回，而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

我并不是真正关注您的“讨论”，当然也不想干预。 但是，我感到有提出一些可能有助于解决您的问题的更改的冲动：

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

笔记：

1. 正如@dpdragnev所建议的那样，以上代码中没有更多选择。
2. 显式编码意味着您不仅仅使用ActiveSheet或Range而不声明您要引用的工作表。
3. Range("H" & CStr(LSearchRow))有一些繁琐的用法，我将其更改为Cells(LSearchRow, "H") 。 我相信这更容易理解，并且我知道Cells比Range更快。
4. Dim已移到x循环之外。 无需将东西Dim 50次。
5. 当使用具有多个变量的Dim ，您需要为每个变量重复变量类型。 因此，您需要将Dim LSearchRow as Integer, LCopyToRow As Integer编写Dim LSearchRow as Integer, LCopyToRow As Integer编写Dim LSearchRow as Integer, LCopyToRow As Integer ，而不是Dim LSearchRow, LCopyToRow As Integer将Dim LSearchRow as Integer, LCopyToRow As Integer 。
6. 我认为Integer还可以。 但是最终（在处理Excel行时）您可能会超过32,000（或其他）行。 因此，最好选择Long 。
7. 现在，在x循环的开始处有一个小的“额外”字符，用于在处理表单之前验证表单的存在（只是为了采取措施）。

除此之外。 我暂时找不到任何东西。 当然，还有更多可以改进的地方。 但是，我不想在周围更改太多代码。 你们两个为此付出了很多努力。

_{上面的代码尚未经过测试。 我只是从脑子里写出来的，可能包含一些需要调整的缺陷。 在这种情况下，请随时向我询问。}

Answer 2

可能是因为最初选择了Sheet（1），但是稍后在While循环中却使用了sheets（“ PO”＆x）.Select？ 焦点将切换到新的工作表，而您在while循环条件下寻找的数据可能不存在。

没有看到您的实际文件，这只是一个猜测。

Answer 3

希望这行得通

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 4

通过更改@Ralph的代码使其正常工作。 我无法按原样粘贴，但可以根据旧代码进行调整，它就像一个魅力。 工作代码成功如下：

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

感谢@ Ralph，@ dpdragnev和@csanjose在这里发布！