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

我正试图在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所build议的，在上面的代码中没有更多的select。
2. 显式编码意味着你不只是使用ActiveSheet或者Range而没有说明你正在引用哪张表。
3. Range("H" & CStr(LSearchRow))有一些繁琐的使用，我把它改为Cells(LSearchRow, "H") 。 我相信这个更清晰，我知道Cells比Range更快。
4. Dim被移到了x循环之外。 没有必要Dim 50次。
5. 当使用Dim与多个variables，那么你需要重复每个variables的variablestypes。 因此，而不是Dim LSearchRow, LCopyToRow As Integer您需要将Dim LSearchRow as Integer, LCopyToRow As Integer写Dim LSearchRow as Integer, LCopyToRow As Integer 。
6. 我想Integer现在就好了。 但最终（当处理Excel行时），你可能会超过32000（和某些）行。 所以，跟Long一起去可能更好。
7. 现在在x循环的开始处有一个小的“额外”，在处理之前validation纸张的存在（只是为了好的措施）。

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

_{上面的代码还没有经过testing。 我只是从头顶写下来，可能还包括需要调整的缺陷。 在这种情况下，请随时向我提问。}

Answer 2

难道是因为最初你select了Sheet（1），但后来在While循环中使用了表格（“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谁张贴在这里！