VBA循环通过工作表运行代码不循环或循环但不运行代码答案

【问题标题】：VBA to loop through worksheets running code either doesnt loop or does loop but doesnt run codeVBA循环通过工作表运行代码不循环或循环但不运行代码
【发布时间】：2018-02-28 12:52:10
【问题描述】：

我正在尝试遍历所有工作表，除了一个名为“摘要”的工作表，向下查看 A 列中的一个范围，直到找到一个值，然后查看另一个工作簿并获取一些数据，将其粘贴，然后继续直到A 列范围的末尾。然后它应该移动到下一个工作表并重复该过程。我已经能够成功地在循环中执行代码，但只能在活动工作表上。我尝试了“for each”语句的各种迭代。当前的方式似乎循环通过工作表，但不运行代码。

如何修改它以使其正常工作？

    Sub GetFlows()

Dim rng As Range
Dim row As Range
Dim cell As Range
Dim dem1 As String
Dim WhereCell As Range
Dim ws As Excel.Worksheet
Dim iIndex As Integer

Dim valueRng As Range
Dim x As Long
Dim y As Long


Set rng = Range("A9:A200")

For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "summary" Then
        ws.Activate
            For x = 1 To rng.Rows.Count

            dem1 = rng.Cells(x).Value

            If dem1 <> "" Then
                Set WhereCell = ThisWorkbook.ActiveSheet.Range("A9:A200").Find(dem1, lookat:=xlPart)
                Windows("GetFilenames v2.xlsm").Activate
                Worksheets(dem1).Range("A1").CurrentRegion.Copy
                WhereCell.Offset(, 2).PasteSpecial Paste:=xlPasteValues
                Else
                ThisWorkbook.Activate
            End If

            Next x
    End If
Next ws


End Sub

【问题讨论】：

第一步是找出你的问题：你的代码能运行吗？在循环中添加断点或 MsgBox 函数调用，然后运行代码并查看它是否命中。如果不是，那么您的条件逻辑是错误的。如果是这样，则使用 F8 逐步调试，看看有什么问题。
查看how to debug VBA的建议
您也会想要avoid using select/activate，因为如果您经常“激活”并选择各种工作簿或工作表，即使是像您这样相对简单的代码也会很快变得复杂且难以追踪. 99.9% 没有必要这样做，而且这样做实际上会使您的代码更难阅读、调试等。

标签： vba excel loops

【解决方案1】：

您可以避免使用所有Activate 和Select，并使用With ws 限定您所有的Range 和Cells 内部状态。

所以在你遍历所有Worksheets 之后：

For Each ws In ThisWorkbook.Worksheets，你加上With ws，里面的所有对象都被ws对象限定了。

代码：

Option Explicit

Sub GetFlows()

Dim cell As Range
Dim dem1 As String
Dim WhereCell As Range
Dim ws As Worksheet

Dim valueRng As Range
Dim x As Long
Dim y As Long

For Each ws In ThisWorkbook.Worksheets
    With ws
        If .Name <> "summary" Then
            For x = 9 To 200 ' run a loop from row 9 to 200
                dem1 = .Range("A" & x).Value

                If dem1 <> "" Then
                    Set WhereCell = .Range("A9:A200").Find(what:=dem1, LookAt:=xlPart)
                    If Not WhereCell Is Nothing Then
                        Workbooks("GetFilenames v2.xlsm").Worksheets(dem1).Range("A1").CurrentRegion.Copy
                        WhereCell.Offset(, 2).PasteSpecial xlPasteValues
                    End If
                End If
            Next x
        End If
    End With
Next ws

End Sub

【讨论】：

我在 Windows("GetFilenames v2.xlsm").Worksheets(dem1).Range("A1" ).CurrentRegion.Copy，在 'If not' 语句之后。
@RichPrag 您确定工作簿和工作表的名称吗？ dem1 的价值是多少？
对不起，我错过了目标工作簿中实际上大写的“摘要”。所以我的错误，它完美地工作。感谢您的帮助！

【解决方案2】：

你可以试试这个吗？这会检查是否找到了值。

Sub GetFlows()

Dim rng As Range
Dim row As Range
Dim cell As Range
Dim dem1 As String
Dim WhereCell As Range
Dim ws As Excel.Worksheet
Dim iIndex As Integer

Dim valueRng As Range
Dim x As Long
Dim y As Long

Set rng = Range("A9:A200") ' should specify a sheet here, presumably Summary?

For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "summary" Then
        For x = 1 To rng.Rows.Count
            dem1 = rng.Cells(x).Value
            If dem1 <> vbNullString Then
                Set WhereCell = ws.Range("A9:A200").Find(dem1, lookat:=xlPart)
                If Not WhereCell Is Nothing Then
                    Workbooks("GetFilenames v2.xlsm").Worksheets(dem1).Range("A1").CurrentRegion.Copy
                    WhereCell.Offset(, 2).PasteSpecial Paste:=xlPasteValues
                End If
            End If
        Next x
    End If
Next ws

End Sub

【讨论】：