Excel VBA-循环单列数组

Question

我有2个专业（Master＆Sample）。如果我在示例工作表中有一个值匹配项（在A列中有一个唯一值），我试图写一个宏来更新工作表中的数据，否则需要在工作表的末尾插入一个新行。我已经为我的母版添加了样本数据，并在图像中添加了样本，请帮助我找到这样做的逻辑。

主表的示例数据：

样本表和注释的示例数据：

Answer 1

更新主工作表

调整五个常量（ Const ）以适合您的需求。

代码

Sub UpdateMaster()

    Const cMaster As String = "Master"  ' Master Worksheet Name
    Const cSample As String = "Sample"  ' Sample Worksheet Name
    Const cCols As String = "A:D"       ' Data Columns Range Address (or "1:4")
    Const cLRC As Variant = "A"         ' Last-Row Column Letter/Number (or 1)
    Const cFR As Long = 2               ' First Row Number

    Dim rng As Range      ' Last Used Cell in Last-Row Column of both
                          ' Worksheets, Sample/Master/Unique Range
    Dim vntM As Variant   ' Master Array
    Dim vntS As Variant   ' Sample Array
    Dim vntR As Variant   ' Row Array
    Dim vntU As Variant   ' Unique Array
    Dim MNoR As Long      ' Master Number of Rows
    Dim SNoR As Long      ' Sample Number of Rows
    Dim Cols As Long      ' Number of Columns in Data Columns Range
    Dim i As Long         ' Sample/Unique Array Row Counter
    Dim j As Long         ' Sample/Master/Unique Array Column Counter
    Dim k As Long         ' Master Array Row Counter
    Dim m As Long         ' Row Array Row Count(er)

    ' Speed up.
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    ' Handle errors.
    On Error GoTo ErrorHandler

    ' In (Last-Row Column of) Sample Worksheet
    With ThisWorkbook.Worksheets(cSample).Columns(cLRC)
        ' Create a reference to Last Used Cell.
        Set rng = .Find("*", , xlFormulas, , xlByColumns, xlPrevious)
        ' Check if no data in column.
        If rng Is Nothing Then
            MsgBox "No data in column '" & Split(.Cells(1).Address, "$")(1) _
                & "'.", vbCritical, "Column Empty"
            GoTo ProcedureExit
        End If
        ' Calculate Sample Number of Rows.
        SNoR = rng.Row - cFR + 1
        ' Create a reference to Sample Range.
        Set rng = .Parent.Columns(cCols).Rows(cFR).Resize(SNoR)
        ' Copy Sample Range to Sample Array.
        vntS = rng
    End With

    ' In (Last-Row Column of) Master Worksheet
    With ThisWorkbook.Worksheets(cMaster).Columns(cLRC)
        ' Create a reference to Last Used Cell.
        Set rng = .Find("*", , xlFormulas, , xlByColumns, xlPrevious)
        ' Check if no data in column.
        If rng Is Nothing Then
            MsgBox "No data in column '" & Split(.Cells(1).Address, "$")(1) _
                & "'.", vbCritical, "Column Empty"
            GoTo ProcedureExit
        End If
        ' Calculate Master Number of Rows.
        MNoR = rng.Row - cFR + 1
        ' In Data Columns Range
        With .Parent.Columns(cCols)
            ' Calculate Number of Columns in Data Columns Range.
            Cols = .Columns.Count
            ' Create a reference to Master Range.
            Set rng = .Rows(cFR).Resize(MNoR)
            ' Copy Master Range to Master Array.
            vntM = rng
        End With
    End With

    ' Resize Row Array to Sample Number of Rows (as big as it could get).
    ReDim vntR(1 To SNoR)

    ' Loop through rows of Sample Array.
    For i = 1 To SNoR
        ' Loop through rows of Master Array.
        For k = 1 To MNoR
            ' Check if value of element at current row in 1st column of Source
            ' Array is equal to the value of element at current row in 1st
            ' column of Master Array.
            If vntS(i, 1) = vntM(k, 1) Then ' Match FOUND.
                ' Loop through the rest of the columns (to update the values).
                For j = 2 To Cols
                    ' Write value of element at current row in current column
                    ' of Source Array to element at current row in current
                    ' column of Master Array.
                    vntM(k, j) = vntS(i, j)
                Next
                ' Stop looping through rows of Master Array (unique values).
                Exit For
            End If
        Next
        ' Check if no match was found using the 'For Next Trick' i.e. when the
        ' for next loop finishes uninterupted, the value of the 'counter' is
        ' by 1 greater than the 'end' (VBA Help: "For counter = start To end").
        If k = MNoR + 1 Then
            ' Count the number of rows in Row Array.
            m = m + 1
            ' Write the current row number of Sample Array to Row Array.
            vntR(m) = i
        End If
    Next

    ' Check if new values found.
    If m > 0 Then
        ' Resize Row Array to number of new values found.
        ReDim Preserve vntR(1 To m)

        ' Resize Unique Array to number of rows of Row Array and to Cols
        ' number of columns.
        ReDim vntU(1 To m, 1 To Cols)

        ' Loop through rows of Row/Unique Array
        For i = 1 To m
            ' Loop through columns of Sample/Unique Array.
            For j = 1 To Cols
                ' Write the rows (containded in Row Array) of Sample Array to
                ' Unique Array.
                vntU(i, j) = vntS(vntR(i), j)
            Next
        Next
    End If

    ' Erase Row & Sample Arrays. All needed data is in Master & Unique Arrays.
    Erase vntR
    Erase vntS

    ' Copy Master Array to Master Range.
    rng = vntM
    ' Erase Master Array.
    Erase vntM

    ' Check if new values found.
    If m > 0 Then
        ' Create a reference to Unique Range.
        Set rng = rng.Cells(rng.Rows.Count, 1).Offset(1).Resize(m, Cols)
        ' Copy Unique Array to Unique Range.
        rng = vntU
    End If

    MsgBox "The operation finished successfully.", vbInformation, "Success"

ProcedureExit:

    ' Speed down.
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With

Exit Sub

ErrorHandler:

    MsgBox "An unexpected error occurred. Error '" & Err.Number & "': " _
            & Err.Description, vbCritical, "Error"
    GoTo ProcedureExit

End Sub