使用命名列表创建For循环

Question

我正在尝试为下面的代码创建一个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

Answer 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