Excel VBA 宏将工作簿 sheet 中的特定行复制到新摘要 sheet 中......几乎可以工作

Question

我需要能够查看我工作簿中每个作品sheet 中指定范围的单元格，如果它们符合条件，则将该行复制到摘要sheet。下面的代码在大多数情况下都有效，除了在少数情况下它复制不符合条件的行和一个它跳过它应该复制的行的情况。

有没有一种方法可以使用调试工具，以便在循环浏览代码时随时可以看到：什么是活动的 sheet？什么是活性细胞？什么是活动行？等等

此外，我是否应该使用 -For Each Cell in Range- 而不是 -While Len- 在每个 sheet 上循环指定范围？

Sub LoopThroughSheets()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim ws As Worksheet

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

For Each ws In ActiveWorkbook.Worksheets

'Start search in row 7
LSearchRow = 7

While Len(ws.Range("M" & CStr(LSearchRow)).Value) > 0

'If value in column M > 0.8, copy entire row to HH
If ws.Range("M" & CStr(LSearchRow)).Value > 0.8 Then

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

    'Paste row into HH in next row
    Sheets("HH").Select
    Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
    ActiveSheet.Paste

    'Move counter to next row
    LCopyToRow = LCopyToRow + 1

    'Go back to active ws to continue searching
    ws.Activate

End If

LSearchRow = LSearchRow + 1

Wend


Next ws
'Position on cell A1 in sheet HH
Sheets("HH").Select

Application.CutCopyMode = False
Range("A1").Select
MsgBox "All matching data has been copied."

End Sub

Answer 1

关于调试的第一个问题，您可以使用：

Debug.Print "Worksheet: " & ActiveSheet.Name

随时在您的代码中将您所在的 sheet 打印到 Visual Basic 编辑器的 "Immediate" window 中。这非常适合在所有情况下进行调试。

其次，For Each 循环是遍历任何内容的最快方法，但它也有缺点。也就是说，如果你是 deleting/inserting 任何东西，它都会 return 有趣的结果（Copy/Paste 没问题）。如果您不确定需要处理多少行，则最好使用任何类型的 While 循环。

就您的代码而言，这就是我的做法（您仍然需要在 while 循环的上方和下方包含您的代码）：

Dim Items As Range
Dim Item As Range

'This will set the code to loop from M7 to the last row, if you
'didn't want to go to the end there is probably a better way to do it.

Set Items = ws.Range("M7:M26")

For Each Item In Items

'If value in column M > 0.8, copy entire row to HH
If Item.Value > 0.8 Then

    'Select row in active Sheet to copy
    Item.EntireRow.Copy

    'Paste row into HH in next row
    Sheets("HH").Rows(LCopyToRow & ":" & LCopyToRow).PasteSpecial

    'Move counter to next row
    LCopyToRow = LCopyToRow + 1

End If

Next Item

Answer 2

与之前的答案非常相似，只是措辞 differently.Same 结果。

Sub Button1_Click()
    Dim Rws As Long, Rng As Range, ws As Worksheet, sh As Worksheet, c As Range, x As Integer
    Set ws = Worksheets("HH")
    x = 2
    Application.ScreenUpdating = 0
    For Each sh In Sheets
        If sh.Name <> ws.Name Then
            With sh
                Rws = .Cells(Rows.Count, "M").End(xlUp).Row
                Set Rng = .Range(.Cells(7, "M"), .Cells(Rws, "M"))
                For Each c In Rng.Cells
                    If c.Value > 0.8 Then
                        c.EntireRow.Copy Destination:=ws.Cells(x, "A")
                        x = x + 1
                    End If
                Next c
            End With
        End If
    Next sh
End Sub

Excel VBA 宏将工作簿 sheet 中的特定行复制到新摘要 sheet 中......几乎可以工作

Excel VBA macro to copy specific rows from workbook sheets into new summary sheet....almost works

excel

vba