Excel VBA 宏将工作簿表中的特定行复制到新的汇总表中......几乎可以工作
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/28177420/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel VBA macro to copy specific rows from workbook sheets into new summary sheet....almost works
提问by Patrick0427
I need to be able to look at a specified range of cells in every worksheet of my workbook and if they meet criteria, copy that row to a summary sheet. The below code works for the most part except there are a few instances where it copies rows that do not meet the criteria and one instance where it skips a row it should have copied.
我需要能够查看工作簿的每个工作表中指定范围的单元格，如果它们符合条件，则将该行复制到汇总表中。下面的代码在大多数情况下都有效，除了有几个实例复制不符合条件的行和一个实例跳过它应该复制的行。
Is there a way to use a debug tool so that at any time while cycling through the code I can see: What is the active sheet? What is the active cell? What is the active row? etc.
有没有办法使用调试工具，以便在循环代码时随时可以看到：活动表是什么？什么是活动细胞？什么是活动行？等等。
Also, should I use a -For Each Cell in Range- instead of -While Len- to loop through the specified range on each sheet?
另外，我应该使用 -For Each Cell in Range- 而不是 -While Len- 来循环遍历每张纸上的指定范围吗？
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
采纳答案by D_Zab
For your first question about debugging, you can use:
对于关于调试的第一个问题，您可以使用：
Debug.Print "Worksheet: " & ActiveSheet.Name
at any time in your code to print out which sheet you are on into the "Immediate" window in the Visual Basic Editor. This is great for debugging in all scenarios.
在您的代码中的任何时间将您所在的工作表打印到 Visual Basic 编辑器的“立即”窗口中。这非常适合在所有场景中进行调试。
Second, a For Each loop is the fastest way to loop through anything but it has disadvantages. Namely, if you are deleting/inserting anything it will return funny results (Copy/Paste will be ok). Any sort of While loop is better to use if you don't have a predetermined idea of how many rows you are going to need to work through.
其次，For Each 循环是遍历任何内容的最快方法，但它也有缺点。也就是说，如果您要删除/插入任何内容，它将返回有趣的结果（复制/粘贴就可以了）。如果您没有预先确定需要处理多少行，则最好使用任何类型的 While 循环。
As far as your code is concerned this is how I would do it (you would still need to include your code above and below the while loop):
就您的代码而言，这就是我的做法（您仍然需要在 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
回答by Davesexcel
Very similar to the previous answer just worded differently.Same results though.
与之前的答案非常相似，只是措辞不同。但结果相同。
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
