Question

我正在处理excel数据集中的大约9000个数据。我的目标是找到A列（sheet1）和A列（sheet2）之间的匹配值（如果存在匹配项），然后复制工作表2中的整行并将其放在sheet1中的匹配值旁边。如果你们有什么建议可以使它更快地运行，这就是我的代码，那么请告诉我。

Dim sht11 As Worksheet, sht22 As Worksheet

Set sht11 = Worksheets("sheet1")
Set sht22 = Worksheets("sheet2")

Sheet1LastRow = Worksheets("sheet1").Range("A" & 
 Rows.Count).End(xlUp).Row
Sheet2LastRow = Worksheets("sheet2").Range("A" & Rows.Count).End(xlUp).Row

For j = 1 To Sheet1LastRow

    For i = 1 To Sheet2LastRow

        If sht11.Cells(j, 1).Value = sht22.Cells(i, 1).Value Then
            sht11.Cells(j, 9).Resize(1, 124).Value = _
                          sht22.Cells(i, 9).Resize(1, 124).Value


        Else

        End If

      Next i

   Next j

Answer 1

我认为这可能对您有帮助

Option Explicit

Sub test()

    Dim rngToSearchIn As Range, rngFound As Range
    Dim LastRow1 As Long, LastRow2 As Long, i As Long, LastColumn1 As Long, LastColumn2 As Long
    Dim arr As Variant
    Dim strSearchValue As String
    Dim ws1 As Worksheet, ws2 As Worksheet

    With ThisWorkbook
        Set ws1 = .Worksheets("Sheet1")
        Set ws2 = .Worksheets("Sheet2")
    End With

    With ws1
        LastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
        arr = .Range("A1:A" & LastRow1)
    End With

    With ws2
        LastRow2 = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rngToSearchIn = .Range("A1:A" & LastRow2)
    End With

    For i = LBound(arr) To UBound(arr)

        strSearchValue = arr(i, 1)

        Set rngFound = rngToSearchIn.Find(What:=strSearchValue, LookAt:=xlWhole, MatchCase:=True, SearchFormat:=False)

        If Not rngFound Is Nothing Then

            With ws2
                LastColumn2 = .Cells(rngFound.Row, .Columns.Count).End(xlToLeft).Column
                .Range(.Cells(rngFound.Row, 1), .Cells(rngFound.Row, LastColumn2)).Copy
            End With

            With ws1
                LastColumn1 = .Cells(i, .Columns.Count).End(xlToLeft).Column
                .Cells(i, LastColumn1 + 1).PasteSpecial Paste:=xlPasteValues
            End With

        End If

    Next i

End Sub

Answer 2

虽然已经有了有效的答案，但从速度上来说，您与工作表互动的次数越少越好。请参阅下面的替代方法，以及代码中的注释以获取更多详细信息：

Sub copyValues()

Dim wb As Workbook: Set wb = ActiveWorkbook

Dim wsSrc As Worksheet: Set wsSrc = wb.Worksheets("Sheet2")
With wsSrc
    Dim lRowSrc As Long: lRowSrc = .Cells(.Rows.Count, 1).End(xlUp).Row 'get last row in source data
    Dim lColSrc As Long: lColSrc = .Cells(1, .Columns.Count).End(xlToLeft).Column 'get last column in source data
    Dim arrSrc As Variant: arrSrc = .Range(.Cells(1, 1), .Cells(lRowSrc, lColSrc)) 'allocate the data to an array
End With

Dim wsDst As Worksheet: Set wsDst = wb.Worksheets("Sheet1")
With wsDst
    Dim lRowDst As Long: lRowDst = .Cells(.Rows.Count, 1).End(xlUp).Row 'get last row in destination data
    Dim lColDst As Long: lColDst = 8 '.Cells(1, .Columns.Count).End(xlToLeft).Column 'get last column in destination data - if no other data, can use the dynamic version, otherwise use the set value i guess
    Dim arrDst As Variant: arrDst = .Range(.Cells(1, 1), .Cells(lRowDst, lColSrc + lColDst)) '
End With

Dim Rd As Long, Rs As Long, C As Long

For Rd = LBound(arrDst) To UBound(arrDst) 'iterate through all rows in the destination data
    For Rs = LBound(arrSrc) To UBound(arrSrc) 'iterate through all rows in the source data
        If arrDst(Rd, 1) = arrSrc(Rs, 1) Then 'if there is a match
            For C = LBound(arrDst, 2) + lColDst To UBound(arrDst, 2) 'iterate through all columns in the source
                arrDst(Rd, C) = arrSrc(Rs, C - lColDst) 'allocate to the destination array
            Next C

'alternatively, can write the values directly back to the sheet (comment the C loop above and values allocation below the loops)
'            With wsDst
'                .Range(.Cells(Rd, 9), .Cells(Rd, lColSrc + lColDst)).Value = _
'                    wsSrc.Range(wsSrc.Cells(Rs, 1), wsSrc.Cells(Rs, lColSrc)).Value
'            End With

            Exit For
        End If
    Next Rs
Next Rd

With wsDst
    .Range(.Cells(1, 1), .Cells(lRowDst, lColSrc + lColDst)) = arrDst 'put the values back on the sheet
End With

End Sub

谁能建议我如何使此代码更快地工作？

2 个答案: