如何從多個查找值

Question

我工作的宏觀，從2010年的Excel

返回多個項目我有一個名爲「DATA」的第一片，有責任的規則與他們的屬性。

<Rule name   Source  label  Criteria etc… until column V   
RGC-EC-01   AU-DU  AUDIT  =      
RGC-EC-01   DU-FICT  FICT  R    
RGC-EC-01   NNE-ECC  CONTRACT E    
RGC-EC-02   DU-FICT  FICT  >   
RGC-EC-02   LO-DT  DIT   <> 
etc… 

第二張紙被命名爲OUTCOME。 此時除標題外（與數據表相同）沒有數據。本表的目的是根據我正在查找的規則名稱複製表單DATA中的所有數據。

規則名稱顯示在列W（OUTCOME表單）中，有幾個取決於我在尋找什麼（另一個電子表格不用擔心）。 我想報告有關從colum W到OUTCOME表的值的匹配數據。

所以這是如何複製的多行中的一個命令（一個規則有多個行）從多個查找值（多個規則（域單元）。

防爆
W2 = RGC-EC-01
W3 = RGC-EC-02
我想要檢索上述等列出的所有值。

我已完成的陣列式，但它的焦點上一個值（在這個例子中，小區W2）

=IFERROR(INDEX(DATA!A$2:A$7000;SMALL(ROW(DATA!$A$2:$A$7000)*(DATA!$A$2:$A$7000=$W$2);COUNTIF(DATA!$A$2:$A$7000;"<>"&$W$2)+ROW()-1)-1);"") 

我將此公式集成到單元格A2中，然後將其擴展爲從規則名稱中捕獲下一個屬性（Source，Label等...）。它正確地報告了W2上的規則中的所有行，但正如我所說的，我僅限於一個查找值（一個規則）。

宏應循環此數組公式將列W中的所有值集成，而W列不爲空並將數據複製到結果表中。

我已經搜索了2天，但由於缺乏VBA技能，我仍然無法做到。

歡迎所有幫助！ 感謝 問候， 克里斯

Answer 1

如果你想留在你的數組公式，這是你的願望：

{=IFERROR(INDEX(DATA!A:A,SMALL(IF(COUNTIF($W$2:$W$10,DATA!$A$2:$A$1000),ROW($2:$1000)),ROW()-1)),"")} 

編輯

我假設你有興趣就如何通過VBA來實現這一點。我會爲您提供一個簡短的代碼，它可以滿足您的所有需求。

Sub copyByFilter() 
    With Sheets("DATA") 
    Intersect(.[A:V], .UsedRange).AutoFilter 1, Application.Transpose([OUTCOME!W2:W100]), 7 
    Intersect(.[A:V], .UsedRange).Copy [OUTCOME!A1] 
    .[A:V].AutoFilter 
    End With 
End Sub 

首先，它使用內置的自動過濾從Excel只顯示符合您的標準其值。然後，它複製整個範圍並將其粘貼到目的地（格式化並且也以相同的順序，但沒有你不想要的行）。並且作爲最後一步，它會清除您的「數據」中的自動過濾器。這就是說：如果您手動使用自動過濾器，那麼它將在執行後消失（但您可以再次打開它）。;）

沒有「循環」/「變量」/「如果」或類似的東西。只是功能的少量（按順序出現）：

• Sub
• With
• Sheets
• Intersect
• [] (square brackets)
• UsedRange
• AutoFilter
• Application.Transpose *
• Range.Copy

*還有就是Application.Transpose另一種 「奇怪」 的行爲，可以在@ Jon49的回答中可以看出here。

EDIT 2

如果自動過濾是不可能的，那麼在所有線路上運行似乎不可能避免的。我會告訴你如何使用數組公式等來實現這一目標：

COUNTIF(OUTCOME!W2:W***,DATA!A2:A***) 

***需要替換爲適當的行號。這是（對於DATA）：

Range("A" & Rows.Count).End(xlUp).Row 

如果在VBA一個INDEX的Evaluate函數內使用可以返回其跳過部分以檢查每個細胞無數次的陣列（這也是更快）。將所有內容放在一起，我們結束與類似的東西：

Sub copyByFilter2() 
    Dim temp As Variant, xList As Range, i As Long, xRows As Long 
    With Sheets("DATA") 
    xRows = .Range("A" & .Rows.Count).End(xlUp).Row 
    temp = Evaluate("INDEX(COUNTIF(OUTCOME!" & Sheets("OUTCOME").Range("W2", Sheets("OUTCOME").Range("W" & .Rows.Count).End(xlUp)).Address & ", DATA!" & .Range("A1:A" & xRows).Address & "),)") 
    Set xList = .Range("A1:V1") 
    For i = 2 To xRows 
     If temp(i, 1) Then Set xList = Union(xList, Intersect(.Range("A:V"), .Rows(i))) 
    Next 
    xList.Copy Sheets("OUTCOME").Cells(1, 1) 
    End With 
End Sub 

因爲整個EDIT2是通過電話完成的，有可能是在它錯別字。此外，新功能的鏈接列表將被跳過。

如果您還有任何疑問或問題，然後就問/告訴我:)

Answer 2

我所知道的公式可用於執行這是"lookupconcat"學分他的作者。

Answer 3

如果您想要忙碌，這裏有一個VBA解決方案。按ALT + F11打開VB編輯器。在左側的窗口中，找到「當前工作簿」，「VBA項目」下，在下面的代碼，雙擊它，並粘貼：

Option Explicit 

Sub CopyRules() 

    Dim cell As Object 
    Dim rowLoop As Long 
    Dim ruleLoop As Long 
    Dim writeLoop As Long 
    Dim rulesToFind As Variant 
    Dim rowsToCopy As Variant 
    Dim copyCount As Long 

    'Get the unique rules in the selected range into a variant array 
    For Each cell In Selection 

     If Len(cell.value) > 0 Then 

      rulesToFind = FncAddtoVariant(rulesToFind, cell.value) 

     End If 

    Next cell 

    'Get the row numbers that match this criteria into a variant array 
    Do While ruleLoop <= UBound(rulesToFind) 

     'We start at row #2 because we assume headers in row #1 
     For rowLoop = 2 To ActiveSheet.UsedRange.Rows.Count 

      If Range("A" & rowLoop).value = rulesToFind(ruleLoop) Then 

       rowsToCopy = FncAddtoVariant(rowsToCopy, CStr(rowLoop)) 

      End If 

     Next rowLoop 

     ruleLoop = ruleLoop + 1 

    Loop 

    'Copy the rows to the different sheet 
    For copyCount = 2 To UBound(rowsToCopy) + 2 

     Sheets("DATA").Select 
     Rows(rowsToCopy(copyCount - 2) & ":" & rowsToCopy(copyCount - 2)).Select 
     Selection.Copy 
     Sheets("OUTCOME").Select 
     Rows(ActiveSheet.UsedRange.Rows.Count + 1 & ":" & ActiveSheet.UsedRange.Rows.Count + 1).Select 
     ActiveSheet.Paste 

    Next copyCount 

End Sub 

Private Function FncAddtoVariant(arr As Variant, value As String) As Variant 

    Dim i As Integer 

    If Not FncArrayInitialised(arr) Then 

     ReDim arr(0) 
     i = 0 

    Else 

     If Not FncPreviouslyAdded(arr, value) Then 

      i = UBound(arr) + 1 
      ReDim Preserve arr(i) 

     End If 

    End If 

    arr(i) = value 

    FncAddtoVariant = arr 

End Function 

    Private Function FncArrayInitialised(val) As Boolean 

    On Error GoTo FncArrayInitialisedError 

    Dim i 

    If Not IsArray(val) Then GoTo exitRoutine 

    i = UBound(val) 

    FncArrayInitialised = True 
exitRoutine: 

Exit Function 

FncArrayInitialisedError: 

Select Case Err.Number 

     Case 9 'Subscript out of range 

      GoTo exitRoutine 

     Case Else 

      Debug.Print Err.Number & ": " & Err.Description, _ 
       "Error in Initialized()" 
    End Select 

    Debug.Assert False 

    Resume 

End Function 

    Private Function FncPreviouslyAdded(checkArr As Variant, item As String) As Boolean 

    Dim i As Long 
    Dim found As Boolean 

    Do While i <= UBound(checkArr) And found = False 

     If item = checkArr(i) Then found = True 

     i = i + 1 

    Loop 

    FncPreviouslyAdded = found 

End Function 

您應該然後分配一個按鈕，這個宏：https://support.microsoft.com/en-gb/kb/141689

完成此操作後，您可以在工作表的「A」列中選擇一個範圍，然後單擊宏按鈕，並將所有相關列複製到另一個工作表中。