名前付きリストを使って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がRangeかNamed Range（または何か他のもの、おそらくArray）であることがわかっていますか？

4）.Copy OKSheet.Range("A1")ループ内で、何らかの方法でインクリメントせずに、現在のループ反復で、セルA1をフィルタの内容で上書きします。最終的なフィルタ条件が宛先シートのセルA1にあったものであれば、最終的に終了します。

5）1st .AutoFilter各ループの終わりにフィルタをクリアすると、範囲がすでにループの開始時にフィルタリングされているかどうかによって冗長になることがあります。

6）ループ内の次の3行は、ループが定義された範囲を超えているため、実際には何もしない（潜在的にエラーを起こすことはない）ので、私たちは願っています）、あなたは次の要素に戻ります。

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

そして、それは指定された範囲にループしていなかった場合でも、あなたは機能的にループの外で、単一セルの選択を行うことができませんでしたこれらの手順では何も達成しません。そこセルA2で何かないか、または超えて、次の行がある場合

1は .Selectを、避けるべきであるとして

Sheets("Summary").Select 

次可能であれば、は

Sheets("Summary").Activate 

になる可能性スプレッドシートの最後から飛び降りて、Application defined or object defined errorの国に連れて行った。

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

Selection.End(xlDown)シートの最後の行に私達を取った後、さらに2つの行を相殺する試みがあります。

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 

：Rangeオブジェクトコードとして Accountsで

あなたが使用することができ

（と私は外ループの疑いがある）ことを念頭に置い

で

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

は、次のようになります

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 

Arrayなど：

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