使用命名列表创建 For 循环答案

【问题标题】：Creating a For Loop using a named list使用命名列表创建 For 循环
【发布时间】：2018-06-04 16:21:06
【问题描述】：

我正在尝试为下面的代码创建一个 for 循环。

账号列表如下：

[]

For Each Account In Accounts

    With Range("A1", "K" & lngLastRow)
        .AutoFilter
        .AutoFilter Field:=1, Criteria1:=Account
        .Copy OKSheet.Range("A1")
        .AutoFilter
    End With
        Sheets("Summary").Select
        Range("A1").Select
        Selection.End(xlDown).Offset(2, 0).Select

Next Accounts

【问题讨论】：

什么不起作用？

标签： vba excel for-loop

【解决方案1】：

所以在没有更多信息的情况下，让我们看看您发布的内容可能会发生哪些变化：

1) 我看不到您的变量声明，所以我不知道您如何以及是否声明了您的变量，也不知道您是否在顶部有 Option Explicit。因此，您可能会收到诸如Type mismatch 或Application-defined or Object-defined error 之类的错误。我们不知道，你没有说。

2) With Range("A1", "K" & lngLastRow) 我们不知道您是如何计算 lngLastRow 的，因此这可能会由于列中的空单元格而提前终止。它还隐式引用了 Activesheet，因为它不完全限定为范围。

3) For Each Account In Accounts 我们不知道这里的变量类型，所以这可能会导致类型不匹配错误，例如。我不确定Accounts 是一个范围还是一个命名范围（或其他东西，可能是一个数组）？

4) .Copy OKSheet.Range("A1") 在循环内部，如果不以某种方式递增，您将在当前循环迭代中用过滤器的内容覆盖单元格 A1。这意味着，您最终将得到目标工作表中单元格A1 中的最后一个过滤条件。

5) 1st .AutoFilter 您在每个循环结束时清除过滤器，因此这可能是多余的，这取决于是否在循环开始时已经过滤了范围。

6）我认为循环中的以下三行是多余的，因为它们实际上没有做任何事情（除了可能产生错误），因为您的循环超出了定义的范围（绝对是集合对象或数组，我们希望），你会回到下一个元素。

Sheets("Summary").Select
Range("A1").Select
Selection.End(xlDown).Offset(2, 0).Select

即使它没有循环到指定范围，您也无法通过这些步骤在功能上实现任何在循环外选择单个单元格无法完成的事情。

以下

Sheets("Summary").Select

作为一个应该避免.Select的人，在可能的情况下，可以变成

Sheets("Summary").Activate

如果单元格A2 或其他单元格中没有任何内容，则以下行通过尝试跳出电子表格的末尾将我们带到Application defined or object defined error 的土地。

Selection.End(xlDown).Offset(2, 0).Select

Selection.End(xlDown) 已将我们带到工作表的最后一行，然后尝试再偏移两行。

你可以使用（我怀疑在循环之外）

Sheets("Summary").Cells(Sheets("Summary").Rows.Count, "A").End(xlUp).Offset(2, 0).Activate

考虑到这一点

使用Accounts 作为 Range 对象代码可能如下所示：

Option Explicit

Public Sub TEST()

    Dim Accounts As Range  'Variable declarations
    Dim Account As Range

    Dim wb As Workbook
    Dim wsSource As Worksheet
    Dim OKSheet As Worksheet

    Set wb = ThisWorkbook 'Variable assignments
    Set wsSource = wb.Worksheets("Sheet1")
    Set OKSheet = wb.Worksheets("Sheet2")

    Dim lngLastRow As Long
    Dim nextOKRow As Long

    lngLastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row 'find last row by coming from the bottom of the sheet and finding last used cell in column

    Set Accounts = wsSource.Range("A1:A" & lngLastRow) 'define Accounts

    For Each Account In Accounts

        nextOKRow = OKSheet.Cells(OKSheet.Rows.Count, "A").End(xlUp).Row 'increment where you paste

        If nextOKRow > 1 Then nextOKRow = nextOKRow + 1

        With wsSource.Range("A1:K" & lngLastRow) 'fully qualify range   'could also have as  With wsSource.Range("A1", "K" & lngLastRow)
            .AutoFilter 'redundant?
            .AutoFilter Field:=1, Criteria1:=Account
            .Copy OKSheet.Range("A" & nextOKRow) 'here you were just pasting over the same cell each time
            .AutoFilter
        End With

        '  Sheets("Summary").Range("A1").Activate
        'Selection.End(xlDown).Offset(2, 0).Select ' off the sheet.   'not actually doing anything as you revisit the next Account range

    Next Account

     ''Potentially uncomment the following two lines
    'Sheets("Summary").Activate
    'Sheets("Summary").Cells(Sheets("Summary").Rows.Count, "A").End(xlUp).Offset(2, 0).Activate


End Sub

以Accounts 作为命名范围：

Public Sub TEST2()

    Dim Account As Range
    Dim wb As Workbook
    Dim wsSource As Worksheet
    Dim OKSheet As Worksheet

    Set wb = ThisWorkbook
    Set wsSource = wb.Worksheets("Sheet1")
    Set OKSheet = wb.Worksheets("Sheet2")

    Dim lngLastRow As Long
    Dim nextOKRow As Long

    lngLastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

    wsSource.Range("A1:A" & lngLastRow).Name = "Accounts"

    For Each Account In wb.Names("Accounts").RefersToRange

        nextOKRow = OKSheet.Cells(OKSheet.Rows.Count, "A").End(xlUp).Row

        If nextOKRow > 1 Then nextOKRow = nextOKRow + 1

        With wsSource.Range("A1:K" & lngLastRow)
            .AutoFilter
            .AutoFilter Field:=1, Criteria1:=Account
            .Copy OKSheet.Range("A" & nextOKRow)
            .AutoFilter
        End With

    Next Account

End Sub

将Accounts 作为一个数组：

Public Sub TEST3()

    Dim Accounts()  'Variable declarations
    Dim Account As Variant

    Dim wb As Workbook
    Dim wsSource As Worksheet
    Dim OKSheet As Worksheet

    Set wb = ThisWorkbook
    Set wsSource = wb.Worksheets("Sheet1")
    Set OKSheet = wb.Worksheets("Sheet2")

    Dim lngLastRow As Long
    Dim nextOKRow As Long

    lngLastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

    Accounts = wsSource.Range("A1:A" & lngLastRow).Value

    For Each Account In Accounts

        nextOKRow = OKSheet.Cells(OKSheet.Rows.Count, "A").End(xlUp).Row

        If nextOKRow > 1 Then nextOKRow = nextOKRow + 1

        With wsSource.Range("A1:K" & lngLastRow)
             .AutoFilter
            .AutoFilter Field:=1, Criteria1:=Account
            .Copy OKSheet.Range("A" & nextOKRow)
        End With

    Next Account

End Sub

【讨论】：