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

注意：

根据@dpdragnev的建议，上述代码中不再有选择。
明确的编码意味着您不必仅使用ActiveSheet或Range而不说明您所指的是哪个工作表。
Range("H" & CStr(LSearchRow))有一些繁琐的用法，我改为Cells(LSearchRow, "H")。我相信这会更清晰，我知道Cells要比Range更快。
Dim被移到x循环之外。没有必要Dim 50次。
将Dim与多个变量一起使用时，您需要为每个变量重复变量类型。因此，您需要编写Dim LSearchRow, LCopyToRow As Integer。

而不是Dim LSearchRow as Integer, LCopyToRow As Integer
我想Integer现在就好了。但最终（当处理Excel行时）你可能超过32,000（和某些东西）行。因此，最好使用Long。

现在在x循环开始时有一个小的“额外”，在处理之前验证是否存在一张纸（仅用于良好的测量）。

除此之外。我现在找不到任何东西。当然，还有更多可以改进的事情。但是，我不想过多地改变你的代码。你们两个已经付出了很多努力。

_{以上代码已经过不测试。我只是从头顶写下它可能包含需要进行一些调整的缺陷。在这种情况下，请随时向我询问。}

Answer 2

可能是因为您最初选择了Sheet（1），但稍后在While循环中使用了工作表（＆＃34; PO＆＃34;＆amp; x）。选择？焦点将切换到新工作表，并且您在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发布在这里！

＆＃34; WHILE＆＃34;在Excel VBA宏中首次运行后中断

4 个答案: