在vba中一次遍历所有可用的自动过滤器标准 [英] Looping through all available autofilter criteria one at a time in vba

问题描述

我想知道是否有办法在列表中获取所有不同的自动过滤器标准，以便遍历每个条件，最终复制并粘贴每个不同的表，

I was wondering if there was a way to get all the different autofilter criteria in a list in order to iterate through each criteria, to in the end copy and paste each different table that would appear to a separate sheet as it iterates through.

理想情况下，这将运行n次：

Ideally this would be run n times:

ActiveSheet.Range(AllRows).AutoFilter Field:=10, Criteria1:=CritVariable

其中n是不同CritVariables的数量。

Where n is the number of different CritVariables there are.

我想强调，我知道如何复制和粘贴到宏本身，但我很好奇如何迭代所有不同的标准，因为标准可能会因日而异。如果一个列表不可用，我最好如何迭代标准？

I'd like to stress that I know how to copy and paste in the macro itself, but I was curious how to iterate through all the different criteria because the criteria could be different depending on the day. If a list of it isn't available how would I best go about iterating through the criteria?

推荐答案

你可以学习和适应以下。以下是发生了什么的概述。

You can study and adapt the following. Here is an outline of what is going on.

• 我有一个工作人员表，从A5单元开始， b $ b列G;


• 我从G5向下复制（假设此列的数据中没有空格）到W1;


• 从范围W1向下我正在删除重复;


• 然后我循环使用这些数据，使用高级过滤器复制数据每个办公室到从单元格Z1开始的区域;


• 然后将此过滤后的数据移动（剪切）到新的工作表，该工作表是从当前Office名称（标准）命名的; li>
  
• 在每个高级过滤器之后，单元格W2被删除，使W3中的值向上移动，以便可以用于下一个过滤器操作。

• I have a staff-table starting at cell A5, with a list of Offices in column G;
• I'm copying from G5 downwards (assuming there are no blanks in this column's data) to W1;
• From range W1 downwards I am removing duplicates;
• Then I'm looping through this data, using Advanced Filter to copy the data for each office to an area starting at cell Z1;
• This filtered data is then moved (Cut) to a new worksheet, which is named from the current Office name (the criteria);
• After each Advanced Filter the cell W2 is deleted, making the value in W3 move up, so that it can be used for the next filter operation.

这意味着当你按Ctrl-End去到最后使用的单元格时，它会比它需要的更远。如果需要，您可以找到一种方法来解决此问题。）

This does mean that when you press Ctrl-End to go to the last-used cell it goes further than it needs to. You can find a way to resolve this if necessary ;).

Sub SheetsFromFilter()
    Dim wsCurrent As Worksheet
    Dim wsNew As Worksheet
    Dim iLeft As Integer

    Set wsCurrent = ActiveSheet
    Application.ScreenUpdating = False
    Range("G5", Range("G5").End(xlDown)).Copy Range("W1")
    Range("W1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
    iLeft = Range("W1").CurrentRegion.Rows.Count - 1
    Do While iLeft > 0
        wsCurrent.Range("A5").CurrentRegion.AdvancedFilter xlFilterCopy, _
            wsCurrent.Range("W1:W2"), wsCurrent.Range("Z1")
        Set wsNew = Worksheets.Add
        wsCurrent.Range("Z1").CurrentRegion.Cut wsNew.Range("A1")
        wsNew.Name = wsCurrent.Range("W2").Value
        wsCurrent.Range("W2").Delete xlShiftUp
        iLeft = iLeft - 1
    Loop
    wsCurrent.Range("W1").Clear
    Application.ScreenUpdating = True
End Sub

BTW我不打算为您的特定文件修改此;这是你应该做的事情（或支付某人要做的）。

BTW I don't intend to modify this for your specific file; this is something that you should do (or pay someone to do ;) ).

BTW 可以使用正常（而不是高级）过滤器。您仍然会复制列并删除重复。这将有利于不增加工作表的外观尺寸太多。但是我决定这样做;）。

BTW It could be done using the normal (rather than Advanced) Filter. You would still copy the column and remove duplicates. This would have the benefit of not increasing the apparent size of the worksheet too much. But I decided to do it this way ;).

已添加：嗯，我觉得自动完成AutoFilter的启发： p>

Added: Well, I felt inspired to achieve this with AutoFilter as well:

Sub SheetsFromAutoFilter()
    Dim wsCurrent As Worksheet
    Dim wsNew As Worksheet
    Dim iLeft As Integer

    Set wsCurrent = ActiveSheet
    Application.ScreenUpdating = False
    Range("G5", Range("G5").End(xlDown)).Copy Range("W1")
    Range("W1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
    iLeft = Range("W1").CurrentRegion.Rows.Count - 1
    Do While iLeft > 0
        Set wsNew = Worksheets.Add
        With wsCurrent.Range("A5").CurrentRegion
            .AutoFilter field:=7, _
                Criteria1:=wsCurrent.Range("W1").Offset(iLeft).Value
            .Copy wsNew.Range("A1")
            .AutoFilter
        End With
        wsNew.Name = wsCurrent.Range("W1").Offset(iLeft).Value
        iLeft = iLeft - 1
    Loop
    wsCurrent.Range("W1").CurrentRegion.Clear
    Application.ScreenUpdating = True
End Sub

[可以使用定义的名称和一些错误处理/检查来改进这两个过程。

[Both procedures could be improved using Defined Names and some error handling/checking.]

这篇关于在vba中一次遍历所有可用的自动过滤器标准的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！