索引/匹配僅可見單元格

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

編輯：後重新閱讀你原來的問題，我相信你真正需要的是從沒有被隱藏在項目表comments表項目的ID列表。如果可以繪製出來，則可以輕鬆地檢索相關的評論。

我想我會提供一個解決方案，使用數組公式SUBTOTAL來確定項目ID是否隱藏。我選擇了更通用的工作表單元格引用樣式，而不是您的表格式佈局，但它不應該很難轉錄。這是我的示例數據佈局。

在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 +輸入而不是簡單地輸入。輸入正確後，可以根據需要填寫。

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 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

這裏有一個不同的方法，如果它擊中你利益。將此代碼放在第二個工作表（您想自動更新的工作表）中。每次切換到該工作表時，它都會運行。

• 更改1 集FirstSheet = ActiveWorkbook.Sheets（ 「1」）到第一片材的名稱。
• 以Set SecondSheet line的相同方式更新第二張紙。

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，這很好，但你可能要考慮第三張「報告」，在這裏你只是建立了一些循環紙張。只需插入一個按鈕並將其分配給此代碼，就可以得到您想要的結果，而不會混淆您的評論表。這更像是一種查詢報告。

由於沒有任何好的辦法來捕捉過濾器的情況下被應用到工作表，比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