Question

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

最后的想法是将此过滤后的数据复制到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

但仍无效。有什么想法吗？

Answer 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

在高级过滤器中循环

1 个答案: