vba 仅索引/匹配可见单元格

Index/Match Visible Cells Only

提问by Kode

I have an Excel workbook with two worksheets. The first holds a list of projects as follows:

我有一个包含两个工作表的 Excel 工作簿。第一个包含项目列表如下：

Project ID    Project Name
1             Project 1
2             Project 2
3             Project 3

The second holds comments related to the projects:

第二个持有与项目相关的评论：

Project ID    Comment
1             First Comment
1             Second Comment
2             Third Comment
3             Fourth Comment
3             Five Comment

My goal is to filter the comments list to only show the comments related to projects that are displayed, so if I filter out Projects 2 and 3, the comments list only shows as follows:

我的目标是过滤评论列表只显示与显示的项目相关的评论，所以如果我过滤掉项目2和3，评论列表只显示如下：

Project ID    Comment
1             First Comment
1             Second Comment

I am able to filter comments currently by determining if their ID matches an ID in the field, and if so, I have a column filter applied to only show matches. This is done in case someone deleted a project but did not delete the comments related to a project.

我目前可以通过确定评论的 ID 是否与字段中的 ID 匹配来过滤评论，如果是，我将列过滤器应用于仅显示匹配项。这样做是为了防止有人删除了项目但没有删除与项目相关的评论。

 =IF(ISERROR(MATCH([@[Project ID]],ProjectWorksheet[Project ID], 0)), "No Match", "Match")

The problem I have is that if I filter out projects, it shows all comments because Excel is matching against all projects even if they are hidden by the filter instead of only showing comments that match "displayed" projects.

我遇到的问题是，如果我过滤掉项目，它会显示所有评论，因为 Excel 与所有项目匹配，即使它们被过滤器隐藏，而不是只显示与“显示”项目匹配的评论。

I only want comments shown by the displayed projects.

我只想要显示的项目显示的评论。

I have a macro in another workbook that Joins fields based on if the row of data is hidden or not, but is this methodology something I can use so that I can only see comments of projects that are displayed (visible). Here is the macro:

我在另一个工作簿中有一个宏，它根据数据行是否隐藏来连接字段，但是我可以使用这种方法，以便我只能看到显示（可见）的项目注释。这是宏：

Function JoinAll(ByVal BaseValue, ByRef rng As Range, ByVal delim As String)
Application.Volatile
For Each a In rng
If a = BaseValue And a.EntireRow.Hidden = False Then
JoinAll = JoinAll & IIf(JoinAll = "", "", delim) & a(1, 7)
End If
Next a
End Function

If possible, I would love to use a formula.

如果可能的话，我很想使用一个公式。

采纳答案by Kode

Edit:After re-reading your original question, I believe what you really require is a list of Project IDsfrom the Comments table that are not hidden in the Projectstable. If that can be drawn out, the associated comments can be easily retrieved.

编辑：重新阅读您的原始问题后，我相信您真正需要的是Comments 表中未隐藏在Projects表中的项目 ID列表。如果可以提取，则可以轻松检索相关注释。

I thought I'd offer a solution using an array formula with SUBTOTALto determine whether a project ID had been hidden. I opted for a more general worksheet cell reference style rather than your tabled layout but it shouldn't be hard to transcribe. This is my sample data layout.

我想我会提供一个使用数组公式的解决方案，SUBTOTAL以确定项目 ID 是否已被隐藏。我选择了更通用的工作表单元格引用样式，而不是您的表格布局，但转录应该不难。这是我的示例数据布局。

????

？？？

The array formula in D8 is: =IFERROR(INDEX($A$8:$A$99,SMALL(IFERROR(INDEX(ROW($1:$92)+NOT(SUBTOTAL(102,INDIRECT("A"&MATCH($A$8:$A$99,$A$1:$A$6,0))))*1E+99,,),1E+99),ROW(1:1))),"")This requires Ctrl+Shift+Enterrather than simply Enter. Once entered correctly, it can be filled down as necessary.

D8 中的数组公式是： =IFERROR(INDEX($A$8:$A$99,SMALL(IFERROR(INDEX(ROW($1:$92)+NOT(SUBTOTAL(102,INDIRECT("A"&MATCH($A$8:$A$99,$A$1:$A$6,0))))*1E+99,,),1E+99),ROW(1:1))),"")这需要Ctrl+Shift+Enter而不是简单的Enter。输入正确后，可根据需要填写。

The standard formula in E8 is: =IF(LEN($D8),IFERROR(INDEX($B$8:$B$99,SMALL(INDEX(ROW($1:$92)+(($A$8:$A$99<>$D8)*1E+99),,),COUNTIF($D$8:$D8,$D8))),""),"")Fill down as necessary.

E8 中的标准公式是： =IF(LEN($D8),IFERROR(INDEX($B$8:$B$99,SMALL(INDEX(ROW($1:$92)+(($A$8:$A$99<>$D8)*1E+99),,),COUNTIF($D$8:$D8,$D8))),""),"")根据需要填写。

With Project 2hidden, these are the results.

随着项目2隐藏起来，这些都是结果。

????

？？？

I suspect that your own project is a bit more complicated than the sample data you provided but perhaps this can help. When transcribing for your own purposes, remember that ROW(1:92)is the position withinB8:B99, not the actual row on the worksheet.

我怀疑您自己的项目比您提供的示例数据要复杂一些，但也许这会有所帮助。在为您自己的目的转录时，请记住这ROW(1:92)是 中的位置B8:B99，而不是工作表上的实际行。

The array processing is heavily dependent upon the number of rows being examined. In addition, the INDIRECTfunction is considered volatile and will recalculate whenever anything in the workbook changes so expect some calculation lag for large blocks of data.

数组处理在很大程度上取决于被检查的行数。此外，该INDIRECT函数被认为是易变的，并且会在工作簿中的任何内容发生更改时重新计算，因此预计大型数据块会出现一些计算延迟。

I've made that sample mockup workbook available on my OneDrive herefor you to reference and download. Post back in comments if you run into problems.

我做了样品样机工作簿可在我的OneDrive在这里为你参考和下载。如果遇到问题，请在评论中回复。

Remove_Comments_from_Hidden_Projects.xlsx

Remove_Comments_from_Hidden_​​Projects.xlsx

回答by peege

I know you want to do this using Excel Forumlas, and that's fine, but you might want to consider a third sheet "Reports", where you just build the sheet with some loops. Just insert a button and assign it to this code, and you will get the results you want, without messing around with your Comments Sheet at all. It's more of a query Report this way.

我知道您想使用 Excel Forumlas 来执行此操作，这很好，但您可能需要考虑第三个工作表“报告”，您只需在其中构建带有一些循环的工作表。只需插入一个按钮并将其分配给此代码，您就会得到您想要的结果，而根本不会弄乱您的评论表。这种方式更像是一个查询报告。

Since there aren't any good ways to capture the event of the filter being applied to the Worksheet, other than Worksheet_change, and you would have a lot of unnecessary refreshing happening to your Comments sheet if you tried to tap into that event.. Also, if you did, you'd be knee deep in VB anyway. So I'd recommend, just inserting that "Reports" sheet and calling it a day. You just need your header row to match the comments sheet.

由于除了 Worksheet_change 之外，没有任何好的方法可以捕获应用于工作表的过滤器的事件，如果您尝试利用该事件，您的评论表会发生很多不必要的刷新。 ，如果你这样做了，无论如何你都会在 VB 中深陷其中。所以我建议，只需插入“报告”表并收工即可。您只需要标题行来匹配评论表。

Sub VisibleReport()

Dim lastProjectRow As Integer
Dim lastCommentRow As Integer
Dim pRow As Integer
Dim cRow As Integer
Dim rRow As Integer

'Clear the previous reports run on "Reports"
Sheets("Reports").Range("A2:B65000").Clear

'Get the last row of the Projects and Comments Sheets
lastProjectRow = Sheets("Projects").Range("A65536").End(xlUp).Row
lastCommentRow = Sheets("Comments").Range("A65536").End(xlUp).Row

'Set the ReportRow to start on 2
rRow = 2

'Begin Looping through the rows on the Projects Sheet

For pRow = 2 To lastProjectRow

    If Sheets("Projects").Rows(pRow).Hidden = False Then

        'Set the TempID to the current row's projectID
        tempID = Sheets("Projects").Cells(pRow, 1)

        For cRow = 2 To lastCommentRow
            'Check to see if the Project ID matches on the Comment Sheet, and if so, copy A & B of that Row to Report.
            If (Sheets("Comments").Cells(cRow, 1) = tempID) Then
                Sheets("Reports").Cells(rRow, 1) = Sheets("Comments").Cells(cRow, 1)
                Sheets("Reports").Cells(rRow, 2) = Sheets("Comments").Cells(cRow, 2)

                'increment the Row on the Report Sheet.
                rRow = rRow + 1
            End If
        Next cRow
    End If

Next pRow

'Set the Focus on the Report Sheet.
Sheets("Reports").Activate
Range("A1").Select

End Sub

回答by Joeyslaptop

Merry Christmas! I see the macros and my eyes bug out. If you're scared of macros or aren't allowed to have them, and array formulas bog down your processor, try this simple normal-formula method (it requires one additional column in your "Project Names" dataset).

圣诞节快乐！我看到宏，我的眼睛出问题了。如果您害怕宏或不允许拥有它们，并且数组公式使您的处理器陷入困境，请尝试这种简单的常规公式方法（它需要在“项目名称”数据集中增加一列）。

Add a new column anywhere in your "Project Names" dataset (I'm using column A here), add a row number to each row of your "Project Name" dataset by doing this =ROW() and dragging it down to the bottom of your dataset. (Don't hard code it unless you're never going to re-sort your dataset). You now have a super valuable golden column.

在“项目名称”数据集中的任意位置添加一个新列（我在此处使用 A 列），通过执​​行此操作为“项目名称”数据集的每一行添加一个行号 =ROW() 并将其向下拖动到底部你的数据集。（不要对其进行硬编码，除非您永远不会重新排序您的数据集）。您现在拥有一个超值的金柱。

Then try out The following formula (which you can complicate and make fancy later) on a blank worksheet:

然后在空白工作表上尝试以下公式（您可以稍后将其复杂化并进行想象）：

=SUBTOTAL(5,INDIRECT(ADDRESS([the first cell in your "Project Name" dataset range (or the value from the cell above this one if this is a subsequent instance of this formula)]+1,1,1)&":"&ADDRESS(ROW([last cell in your dataset]),1,1),1))

=SUBTOTAL(5,INDIRECT(ADDRESS([“项目名称”数据集范围内的第一个单元格（或者如果这是此公式的后续实例，则为该单元格上方单元格的值）]+1,1,1)& ":"&ADDRESS(ROW([数据集中的最后一个单元格]),1,1),1))

**If your dataset starts at row one, then just use the cell value above this formula (value should be a blank cell or a header) - otherwise you might need to specify the first row of your dataset in the first formula, and then when you drag down or over your formula, use the row-number result provided in the previous formula.*

**如果您的数据集从第一行开始，则只需使用此公式上方的单元格值（值应为空白单元格或标题） - 否则您可能需要在第一个公式中指定数据集的第一行，然后当您向下或拖过公式时，请使用上一个公式中提供的行号结果。*

Drag the formula down to however many rows you want. When the first formula is set up right, it will return the first row number of the filtered dataset. If you drag it down, the next formula down will start at that row number + 1 and provide the next visible row number, etc, etc. until all of the filtered row numbers are accounted for.

将公式向下拖动到所需的行数。当第一个公式设置正确时，它将返回过滤数据集的第一行号。如果向下拖动它，下一个公式将从该行号 + 1 开始，并提供下一个可见的行号，等等，直到所有过滤的行号都被考虑在内。

Now you have a fancy new list of only the non-filtered row numbers from your dataset. In the next column over from these row numbers, you can simply do an =INDIRECT(ADDRESS([value from the cell to the left],[some column number (for example, the one holding the project ID)],1,1,[sheet name]),1) in order to get other row details like the ID or Report Name.

现在，您拥有一个仅包含数据集中未过滤行号的精美新列表。在这些行号的下一列中，您可以简单地执行 =INDIRECT(ADDRESS([从单元格到左侧的值],[某个列号（例如，持有项目 ID 的列号）],1,1 ,[工作表名称]),1) 以获取其他行详细信息，例如 ID 或报告名称。

You can also use this list of row numbers and Project IDs you created in a COUNTIFS formula or some other mechanism to filter your "notes" dataset. For example in your "Notes" dataset, you could add =IF(COUNTIFS([the range containing your fancy new list],[this row's value])>0,"Show","Hide"). Then just auto-filter on "Show".

您还可以使用在 COUNTIFS 公式或其他一些机制中创建的行号和项目 ID 列表来过滤“注释”数据集。例如，在您的“Notes”数据集中，您可以添加 =IF(COUNTIFS([包含您喜欢的新列表的范围],[此行的值])>0,"Show","Hide")。然后只需在“显示”上自动过滤。

I would post pictures demoing this, but I'm not allowed. You'll just have to try it out on your own.

我会发布图片来演示这个，但我不被允许。你只需要自己尝试一下。

回答by GlennFromIowa

Actually, if you have Excel 2007 or later, and both lists have a filter (AutoFilter) applied, there's a cool way to do it using AutoFilter:

实际上，如果您有 Excel 2007 或更高版本，并且两个列表都应用了过滤器（自动过滤器），那么使用自动过滤器有一个很酷的方法：

Sub FilterChildFromParent(ByRef wksParent As Worksheet, _
    ByRef wksChild As Worksheet)

    Dim i As Integer                ' Loop counter
    Dim fltSaved As Filter          ' Var to save Filter on first column
    Dim sFilterTLC As String        ' Address of Filter Top Left Corner

    If wksParent.AutoFilterMode = True Then
        Set fltSaved = wksParent.AutoFilter.Filters(1) ' Save Filter on 1st col
    End If

    ' Expand filter if needed
    If wksParent.AutoFilter.Range.Address <> wksParent.UsedRange.Address Then
        ExpandFilterRange wksParent, wksParent.AutoFilter.Range(1)
        Set wksParent.AutoFilter.Filters(1) = fltSaved
    End If

    ' Now apply filter to Child
    If wksChild.AutoFilterMode = False Then
        sFilterTLC = "A1"
    Else
        sFilterTLC = wksChild.AutoFilter.Range(1).Address
    End If
    ExpandFilterRange wksChild, wksChild.Range(sFilterTLC)
    If Not (fltSaved Is Nothing) Then                   ' If any filter applied
        If fltSaved.On Then
        ReDim filterArray(fltSaved.Count)
            If fltSaved.Count > 1 Then
                For i = 1 To fltSaved.Count
                    filterArray(i) = fltSaved.Criteria1(i)
                Next i
            Else
                filterArray(1) = fltSaved.Criteria1
            End If
            If fltSaved.Operator Then
                wksChild.AutoFilter.Range.AutoFilter 1, filterArray(), _
                    fltSaved.Operator, fltSaved.Criteria2
            Else
                wksChild.AutoFilter.Range.AutoFilter 1, filterArray()
            End If
        Else
            wksChild.AutoFilter.ShowAllData
        End If
    End If

End Sub

Sub ExpandFilterRange(ByRef wks As Worksheet, ByRef rngTLC As Range)
Dim rngFilterPoss As Range       ' Possible filtered cells
' Range from Top Left Corner of Filter to Bottom Right of worksheet
Set rngFilterPoss = Range(rngTLC, wks.Cells(wks.Rows.Count, wks.Columns.Count))
wks.AutoFilterMode = False       ' Turn off Filter
Intersect(rngFilterPoss, wks.UsedRange).AutoFilter      ' Re-apply filter
End Sub

回答by David Rachwalik

Here's a different approach if it strikes your interest. Place this code in the 2nd worksheet (the one you want to update automatically.) It will run every time you switch to that worksheet.

如果它引起您的兴趣，这是一种不同的方法。将此代码放在第二个工作表（您要自动更新的工作表）中。每次切换到该工作表时它都会运行。

• Change the 1 in Set FirstSheet = ActiveWorkbook.Sheets("1")to the 1st sheet's name.
• Update the 2nd sheet in the same way on the Set SecondSheetline.

• 更改1集FirstSheet = ActiveWorkbook.Sheets（“1”）的第1张的名字。
• 在Set SecondSheet行上以相同的方式更新第二个工作表。

Here's a good page on AutoFilter VBA. Let me know if you've any questions.

这是一个关于 AutoFilter VBA 的好页面。如果您有任何问题，请告诉我。

Private Sub Worksheet_Activate()
    Dim FirstSheet As Worksheet
    Dim SecondSheet As Worksheet
    Dim Header As Range

    Set FirstSheet = ActiveWorkbook.Sheets("1")
    Set Header = FirstSheet.Range("A1")
    Set SecondSheet = ActiveWorkbook.Sheets("2")

    'Detect whether Autofilter is active, turn on if not
    If SecondSheet.AutoFilterMode Then
        'Detect whether a filter is active, clear if so
        If SecondSheet.FilterMode Then SecondSheet.ShowAllData
    Else
        SecondSheet.UsedRange.AutoFilter
    End If

    'Grab filter criteria of FirstSheet
    With Header.Parent.AutoFilter
        With .Filters(Header.Column - .Range.Column + 1)
            If Not .On Then Exit Sub
            'Update SecondSheet to match FirstSheet
            If .Operator = xlAnd Then
                SecondSheet.UsedRange.AutoFilter 1, .Criteria1, xlAnd, .Criteria2
            ElseIf .Operator = xlOr Then
                SecondSheet.UsedRange.AutoFilter 1, .Criteria1, xlOr, .Criteria2
            ElseIf .Operator = xlFilterValues Then
                SecondSheet.UsedRange.AutoFilter 1, .Criteria1, xlFilterValues
            Else
                SecondSheet.UsedRange.AutoFilter 1, .Criteria1
            End If
        End With
    End With
End Sub