Question

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

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

第二个包含与项目相关的评论：

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

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

Project ID    Comment
1             First Comment
1             Second Comment

我可以通过确定他们的ID是否与字段中的ID匹配来过滤当前评论，如果是，我有一个列过滤器应用于仅显示匹配。如果有人删除了某个项目但没有删除与项目相关的注释，则会执行此操作。

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

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

我只希望显示的项目显示评论。

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

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

如果可能的话，我很乐意使用公式。

Answer 1

编辑：重新阅读原始问题后，我相信您真正需要的是“评论”表中的项目ID 列表，这些列表未隐藏在< em>项目表。如果可以绘制，则可以轻松检索关联的注释。

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

enter image description here

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 。一旦输入正确，可以根据需要填写。

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))),""),"") 必要时填写。

隐藏 Project 2 ，这些就是结果。

enter image description here

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

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

我已经在我的OneDrive here上提供了该样本工作簿，供您参考和下载。如果遇到问题，请在评论中回复。

Remove_Comments_from_Hidden_Projects.xlsx

Answer 2

实际上，如果您使用的是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

Answer 3

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

将 Set FirstSheet = ActiveWorkbook.Sheets（“1”）中的1更改为第一个工作表的名称。
在设置SecondSheet 行上以相同方式更新第二张。

Here's a good page on 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

Answer 4

我知道您希望使用Excel Forumlas执行此操作，这很好，但您可能需要考虑第三张“Reports”，您只需使用一些循环构建工作表。只需插入一个按钮并将其分配给此代码，您就可以获得所需的结果，而无需弄乱您的评论表。它更像是一种查询报告方式。

由于没有任何好方法可以捕获应用于工作表的过滤器事件，而不是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

Answer 5

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

在“项目名称”数据集中的任何地方添加一个新列（我在这里使用A列），通过执行= ROW（）并将其向下拖动，在“项目名称”数据集的每一行中添加一个行号到数据集的底部。（除非您永远不会对数据集进行重新排序，否则请不要对其进行硬编码）。您现在有了一个超有价值的黄金专栏。

然后在空白工作表上尝试以下公式（您可以将其复杂化，以后再看）：

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

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

将公式拖动到所需的任意多行。正确设置第一个公式后，它将返回过滤后的数据集的第一行号。如果将其向下拖动，则向下的下一个公式将从该行号+ 1开始，并提供下一个可见的行号，依此类推，等等。

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

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

我会发布图片演示此内容，但是我不允许这样做。您只需要自己尝试一下即可。

仅索引/匹配可见细胞

5 个答案: