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

我有两个工作表的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匹配来过滤当前的评论，如果是这样的话，我将列filter应用于仅显示匹配。 这是为了防止有人删除了一个项目，但并没有删除与项目有关的评论。

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

我遇到的问题是，如果我过滤了项目，它会显示所有评论，因为即使它们被filter隐藏，而不是显示与“显示”项目相匹配的注释，Excel仍然与所有项目匹配。

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

我有另一个工作簿中的macros，如果数据的行是隐藏的，但是这种方法是我可以使用，以便我只能看到显示（可见）项目的评论的基础上连接字段。 这是macros：

 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列表。 如果能够提取出来，相关的评论可以很容易地检索。

我以为我会提供一个解决scheme，使用SUBTOTAL数组公式来确定项目ID是否被隐藏 。 我select了一个更一般的工作表单元格引用样式，而不是您的表格式布局，但它不应该很难转录。 这是我的示例数据布局。

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比简单的input 。 input正确后，可以根据需要填写。

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))),""),"")根据需要填写。

项目2隐藏，这是结果。

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

数组处理很大程度上取决于正在检查的行数。 此外， INDIRECT函数被认为是不稳定的，只要工作簿中的任何内容发生改变，就会重新计算，因此对于大块数据，预计会有一些计算滞后。

我已经在我的OneDrive上提供了示例模型工作簿供您参考和下载。 如果遇到问题，请回复评论。

Remove_Comments_from_Hidden_​​Projects.xlsx

Answer 2

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

 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更改为第一个工作表的名称。
• 在Set SecondSheet行上以相同的方式更新第二个工作表。

这是一个关于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论坛做这个，这很好，但是你可能想要考虑第三个工作表“报告”，在那里你只是build立一些循环的工作表。 只要插入一个button，并将其分配给这个代码，你会得到你想要的结果，而不用乱搞你的评论表。 这是更多的查询报告这种方式。

由于没有任何好方法可以捕获应用于工作表的事件，而不是Worksheet_change，所以如果您尝试点击该事件，则会在您的评论表中发生大量不必要的刷新。如果你这样做的话，无论如何你都会在VB中屈膝。 所以我build议，只需插入“报告”表，并称之为一天。 你只需要你的标题行来匹配评论表。

 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