Question

下面你会看到两个截图。第一个有一个矩阵，中间突出显示数据。我能够从SO中的人那里获得一个VBA宏来复制那些突出显示的值并将其粘贴到垂直顺序的新工作表中（在这种情况下，突出显示的值使用条件格式突出显示它显示的值＆lt;或= 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

查找相应数据并将其复制到另一个工作表（公式或VBA）

1 个答案: