查找對應的數據並將其複製到另一個工作表（公式或VBA）

Question

下面您將看到兩個屏幕截圖。第一個有一個矩陣，中間突出顯示數據。我能夠從SO中的人們那裏獲得VBA宏，以複製突出顯示的值並將其粘貼到垂直順序的新工作表中（突出顯示的值使用條件格式突出顯示，在這種情況下，它顯示的值爲<或= 50）。這是第二張屏幕截圖，顯示按垂直順序粘貼的高亮值。現在我的問題是，我需要找到相應的SAP＃以突出顯示值（屏幕截圖1），然後將其垂直粘貼到距離列旁邊（屏幕截圖2）。注意有一個SAP＃列和一個SAP＃行。我將需要這兩個SAP＃對應於突出顯示的值。我試過使用INDEX-MATCH，但是我得到了錯誤的答案，並且我不是For Next編碼方面的專家，所以我甚至無法編寫任何代碼。

想在這個問題上有所幫助。僅供參考，這只是我的大型數據集中的一小部分。我有數百個列和行。這裏就是我用來複制數據的代碼：

Sub CopyConditionalData() 

    Application.ScreenUpdating = False 

    Dim ws1 As Worksheet, ws2 As Worksheet 
    Set ws1 = Worksheets("Location Analysis")   ' change as needed 
    Set ws2 = Worksheets("Output")     ' change as needed 

    Dim rRng As Range 
    Set rRng = ws1.Range("E5:ZZ200")     'change as needed 

    Dim aRng As Variant 
    aRng = rRng 

    Dim lRows As Long, lCols As Long 
    For lCols = 1 To rRng.Columns.Count 
     For lRows = LBound(aRng) To UBound(aRng) 
      If aRng(lRows, lCols) <= ws1.Range("D1") Then 
       ws2.Range("A" & ws2.Rows.Count).End(xlUp).Offset(1) = aRng(lRows, lCols) 
      End If 
     Next 
    Next 

    ws2.Select 

End Sub 

Answer 1

一個問題我看到的複雜化，這是要帶過來的附加數據是你的陣列以外的：它會更容易從A1開始獲取數據，然後調整For循環的起點。

此外，在您的屏幕截圖中沒有可見的列/行標題，這使得我有更復雜的位置映射。

未經檢驗 - 調整以適應：

Sub CopyConditionalData() 

    Application.ScreenUpdating = False 

    Dim ws1 As Worksheet, ws2 As Worksheet 
    Set ws1 = Worksheets("Location Analysis")   ' change as needed 
    Set ws2 = Worksheets("Output")     ' change as needed 

    Dim rRng As Range 
    Set rRng = ws1.Range("A1:ZZ200") '<< ##note now starting from A1## 

    Dim aRng As Variant 
    aRng = rRng.Value 

    Dim lRows As Long, lCols As Long 
    '##adjust the loop start points to mimic E5## 
    For lCols = 5 To UBound(aRng, 2) 
     For lRows = 5 To UBound(aRng, 1) 
      If aRng(lRows, lCols) <= ws1.Range("D1") Then 
       With ws2.Range("A" & ws2.Rows.Count).End(xlUp).Offset(1, 0) 
        .Value = aRng(lRows, lCols) 
        .Offset(0, 1).Value = aRng(lRows, 2) 'from ColB 
        .Offset(0, 2).Value = aRng(1, lCols) 'row1 ? 
       End With 
      End If 
     Next 
    Next 

    ws2.Select 

End Sub