Question

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

帐户列表如下：

[ enter image description here ]

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

使用命名列表创建For循环

1 个答案: