高级过滤器中的循环答案

【问题标题】：loop in advanced filter高级过滤器中的循环
【发布时间】：2017-03-17 16:08:46
【问题描述】：

我正在尝试构建一个循环来选择数组中的不同名称并在高级过滤器中使用它们，以将过滤后的数据复制到不同的工作表中。调试说：过滤器有问题（我使用了录制工具）。

最后的想法是将这些过滤后的数据复制到 Outlook 电子邮件中，不过离那里还有些远。

知道为什么它不起作用吗？

Private Sub loopfilter()

Dim VersandRange As Range
Dim rng As Range
Dim Name As String

Set VersandRange = Range("J2", Cells(Rows.Count, "j").End(xlUp))

    For Each rng In VersandRange

        Worksheets("Filtro").Range("AK2") = rng.Value
        Application.CutCopyMode = False
        Worksheets("Alle gemahnten Posten (2)").Range("A1").CurrentRegion.AdvancedFilter Action _
        :=xlFilterCopy, CriteriaRange:=Range("A1:AK2"), CopyToRange:=Range("A5"), _
        Unique:=False

        Range("a5").CurrentRegion.Copy

        Worksheets.Add.Name = rng.Value

        ActiveSheet.Range("A1").Paste

    Next

End Sub

更新 1：

非常感谢您的提示

我今天早上一直在努力使它工作，调整参考。到目前为止，它看起来像这样：

Private Sub loopfilter()

Dim thisWB As Workbook
Dim filterws As Worksheet
Dim howto As Worksheet
Dim advfilter As Range
Dim Postenws As Worksheet
Dim VersandRange As Range
Dim rng As Range
Dim Name As String

Set thisWB = ThisWorkbook
Set filterws = thisWB.Sheets("Filtro")
Set howto = thisWB.Sheets("How to")
Set advfilter = filterws.Range("A1:AK2")
Set Postenws = thisWB.Sheets("Alle gemahnten Posten (2)")
Set VersandRange = howto.Range("J2", Cells(Rows.Count, "j").End(xlUp))

Dim newWS As Worksheet

    For Each rng In VersandRange
        filterws.Range("AK2") = rng.Value
        Application.CutCopyMode = False
        Postenws.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
                                                          CriteriaRange:=advfilter, _
                                                          CopyToRange:=filterws.Range("A5"), _
                                                          Unique:=False
        filterws.Range("a5").CurrentRegion.Copy
        Set newWS = thisWB.Sheets.Add
        newWS.Name = rng.Value
        newWS.Range("A1").Paste
    Next

我在 for 循环中的最后两行遇到了麻烦。

我试过了

Name = rng.value
newWS.Name = Name

但仍然无法正常工作。有什么想法吗？

【问题讨论】：

您的条件和 copytorange 没有工作表参考，这可能是个问题。你遇到了什么错误？

标签： vba excel loops

【解决方案1】：

代码的良好开端。我将提出一些建议来帮助您避免调试中的一些困难。

定义并设置对Worksheets 和Workbooks 的引用。这将有助于您在以后尝试扩展工作时避免出现问题。
通过为数据的来源和去向定义描述性名称来帮助自己。

我的猜测是您的问题正在发生，因为您的Ranges 没有指定使用哪个Worksheet。请参阅下面的示例：

Option Explicit

Private Sub loopfilter()
    Dim VersandRange As Range
    Dim rng As Range
    Dim Name As String

    Dim thisWB As Workbook
    Dim filterWS As Worksheet
    Dim postenWS As Worksheet
    Dim advFilter As Range
    Set thisWB = ThisWorkbook
    Set filterWS = thisWB.Sheets("Filtro")
    Set postenWS = thisWB.Sheets("Alle gemahnten Posten (2)")
    Set advFilter = filterWS.Range("A1:AK2")

    Set VersandRange = postenWS.Range("J2", _
                          postenWS.Cells(postenWS.Rows.Count, "j").End(xlUp))

    Dim newWS As Worksheet
    For Each rng In VersandRange
        filterWS.Range("AK2") = rng.Value
        Application.CutCopyMode = False
        postenWS.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
                                                          CriteriaRange:=advFilter, _
                                                          CopyToRange:=filterWS.Range("A5"), _
                                                          Unique:=False
        filterWS.Range("a5").CurrentRegion.Copy
        Set newWS = thisWB.Sheets.Add
        newWS.Name = rng.Value
        newWS.Range("A1").Paste
    Next

End Sub

【讨论】：