arrays - 使用数组并一一返回值

Question

我想运行在 2 个工作表中分配一些数组的代码，并根据匹配将数据从一张工作表返回到另一张工作表。

在工作表 1 中:

这里，我有 3 列数据(例如，没有那么多行，但会更多):

在工作表 2 中我有以下数据:

因此，我想要做的就是将sheet2中的C列与sheet1中的A列进行匹配，即根据ID进行匹配。基于此匹配，如果在sheet2中的E列中是文本"is"，那么从sheet1的A列和B列中，我想将值分别写入sheet2的F列和G列中。 “姓名”和“号码”。

因此，这是我运行代码后在sheet2中想要实现的结果:

我想将sheet1中的数据列分配给数组，对于sheet2中具有ID的列也是如此。我将获得更多数据!

我的代码的问题是，它实际上只返回sheet1中“Name”和“Number”的第一个值，其中包含尽可能多的“Yes”，而不是根据与sheet2中的iID匹配逐个返回sheet1中的值' 就像在sheet2 中一样(它将返回值加倍)，而不是一个接一个地返回。

这是我的代码:

Sub test()

Dim w_result As Worksheet
Dim w1 As Worksheet

Dim r As Long
Dim d As Long
Dim intLastRow As Long
Dim IntLastRow_Result As Long
Dim IntLastCol As Long

Dim arrID() As Variant
Dim arrName() As Variant
Dim arrNumber() As Variant


With ThisWorkbook
    Set w1 = .Sheets("Sheet1")
    Set w_result= .Sheets("Sheet2")
End With


With w1
    intLastRow = .Cells(.Rows.Count, 1).End(xlUp).row
    IntLastRow_Result = w_result.Cells(Rows.Count, 3).End(xlUp).row

    arrID = .Range(.Cells(5, 3), .Cells(intLastRow, 3))
    arrName= .Range(.Cells(5, 1), .Cells(intLastRow, 1))
    arrNumber= .Range(.Cells(5, 2), .Cells(intLastRow, 2))


   For r = 1 To UBound(arrID , 1)
        If Len(arrID (r, 1)) > 0 Then
            For d = 4 To IntLastRow_Result
                If w_result.Cells(d, 3) = arrID (r, 1) Then
                    If w_result.Cells(d, 5) = "Yes" Then
                        w_result.Cells(d, 6) = arrName(r, 1)
                        w_result.Cells(d, 7) = arrNumber(r, 1)
                    End If
                End If
            Next
        End If
    Next r

End With

End Sub

如果您能提供任何帮助，我将不胜感激!

Answer 1

您的错误是，每次找到匹配项时，For d =... 循环都会覆盖以前的结果。

一个快速而肮脏的修复方法是测试结果行是否为空，如果发现写入结果为空，则退出内部 for 循环。

Sub test()
    Dim w_result As Worksheet
    Dim w1 As Worksheet

    Dim r As Long
    Dim d As Long
    Dim intLastRow As Long
    Dim IntLastRow_Result As Long
    Dim IntLastCol As Long

    Dim arrID() As Variant
    Dim arrName() As Variant
    Dim arrNumber() As Variant

    Dim ResultRow As Long

    With ThisWorkbook
        Set w1 = .Sheets("Sheet1")
        Set w_result = .Sheets("Sheet2")
    End With

    With w1
        intLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        IntLastRow_Result = w_result.Cells(w_result.Rows.Count, 3).End(xlUp).Row '<~~ removed implicit active sheet reference

        arrID = .Range(.Cells(5, 3), .Cells(intLastRow, 3))
        arrName = .Range(.Cells(5, 1), .Cells(intLastRow, 1))
        arrNumber = .Range(.Cells(5, 2), .Cells(intLastRow, 2))

        For r = 1 To UBound(arrID, 1)
            If Len(arrID(r, 1)) > 0 Then
                For d = 4 To IntLastRow_Result
                    If w_result.Cells(d, 3) = arrID(r, 1) Then
                        If w_result.Cells(d, 5) = "Yes" Then
                            If IsEmpty(w_result.Cells(d, 6)) Then '<~~~ Added
                                w_result.Cells(d, 6) = arrName(r, 1)
                                w_result.Cells(d, 7) = arrNumber(r, 1)
                                Exit For  '<~~~ Added
                            End If
                        End If
                    End If
                Next
            End If
        Next r
    End With
End Sub

_{注意:这是一个非常低效的解决方案，但对于小数据集来说还可以。}

<小时/>

这是一个更有效的版本，利用 Variant Array 来获取结果，并更新内部循环的起始索引

Sub test()
    Dim w_result As Worksheet
    Dim w1 As Worksheet

    Dim r As Long
    Dim d As Long
    Dim intLastRow As Long
    Dim IntLastRow_Result As Long
    Dim IntLastCol As Long

    Dim arrID() As Variant
    Dim arrName() As Variant
    Dim arrNumber() As Variant
    Dim Results() As Variant
    Dim ResultStart As Long
    Dim ResultRow As Long

    With ThisWorkbook
        Set w1 = .Sheets("Sheet1")
        Set w_result = .Sheets("Sheet2")
    End With

    With w1
        intLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        IntLastRow_Result = w_result.Cells(w_result.Rows.Count, 3).End(xlUp).Row '<~~ removed implicit active sheet reference
        Results = w_result.Cells(1, 1).Resize(IntLastRow_Result, 8).Value
        w_result.Activate
        arrID = .Range(.Cells(5, 3), .Cells(intLastRow, 3))
        arrName = .Range(.Cells(5, 1), .Cells(intLastRow, 1))
        arrNumber = .Range(.Cells(5, 2), .Cells(intLastRow, 2))

        ResultStart = 4
        For r = 1 To UBound(arrID, 1)
            If Len(arrID(r, 1)) > 0 Then
                For d = ResultStart To IntLastRow_Result
                    If Results(d, 3) = arrID(r, 1) Then
                        If Results(d, 5) = "Yes" Then
                            If IsEmpty(Results(d, 6)) Then '<~~~ Added
                                Results(d, 6) = arrName(r, 1)
                                Results(d, 7) = arrNumber(r, 1)
                                Exit For  '<~~~ Added
                            End If
                        End If
                        ResultStart = ResultStart + 1
                    End If
                Next
            End If
        Next r
    End With
    w_result.Cells(1, 1).Resize(IntLastRow_Result, 8).Value = Results
End Sub