excel - 当两列单元格中的值与另一张表中相同列中的值匹配时，复制整行

Question

Option Explicit

Sub test()
 
  Dim rg As Range
  Dim name As String
  Dim name2 As String
  Dim wsh1 As Worksheet, wsh2 As Worksheet
  Dim i As Long

 
  Set wsh1 = ThisWorkbook.Worksheets("Database")
  Set wsh2 = ThisWorkbook.Worksheets("Løbs-skabelon")
  
  On Error GoTo 0

  Application.ScreenUpdating = False
  
  name = wsh2.Range("a" & Rows.Count).End(xlUp).Value
  name2 = wsh2.Range("e" & Rows.Count).End(xlUp).Value

  For i = 1 To wsh1.Range("a" & Rows.Count).End(xlUp).Row
    
  If wsh1.Cells(i, 1) = name And wsh1.Cells(i, 5) = name2 Then

  wsh1.Range(wsh1.Cells(i, 1), wsh1.Cells(i, 9)).Copy
  
 wsh2.Range("a" & Rows.Count).End(xlUp).PasteSpecial xlPasteValues
  Application.CutCopyMode = False
     
 End If

 Next i
 
Application.ScreenUpdating = True

Worksheets("Løbs-skabelon").Range("a3").Select

Exit Sub

End Sub

我有两张床单。一个是包含从 A 列到 I 列中的所有信息的数据库。在另一张表中，我在列中具有相同的结构，但只有 A 列和 E 列中的信息，这将给出仅匹配数据库中一行的唯一组合。
因此，只有当 A 列和 E 列中的单元格与数据库中的一行匹配时，我才希望将数据库中的整行复制到该行中。到目前为止，我的 vba 只复制一行/最后一行...
worksheet
database

Answer 1

更新工作表行

Option Explicit

Sub UpdateWorksheetRows()
 
    Const sName As String = "Database"
    Const sfRow As Long = 5
    
    Const dName As String = "Lobs-skabelon"
    Const dfRow As Long = 5
    
    Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets(sName)
    Dim slRow As Long: slRow = sws.Range("A" & sws.Rows.Count).End(xlUp).Row
    Dim srCount As Long: srCount = slRow - sfRow + 1
    Dim srg1 As Range: Set srg1 = sws.Range("A5").Resize(srCount)
    Dim srg2 As Range: Set srg2 = sws.Range("E5").Resize(srCount)
    
    Dim dws As Worksheet: Set dws = ThisWorkbook.Worksheets(dName)
    Dim dlRow As Long: dlRow = dws.Range("A" & dws.Rows.Count).End(xlUp).Row
    Dim drCount As Long: drCount = dlRow - dfRow + 1
    
    Application.ScreenUpdating = False
    
    Dim sIndex As Variant
    Dim r As Long
     
    For r = dfRow To dlRow
        sIndex = dws.Evaluate("MATCH(1,('" & sName & "'!" & srg1.Address & "=" _
            & dws.Range("A" & r).Address & ")*('" & sName & "'!" _
            & srg2.Address & "=" & dws.Range("E" & r).Address & "),0)")
        If IsNumeric(sIndex) Then
            'Debug.Print r, sIndex
            dws.Rows(r).Columns("A:I").Value _
                = srg1.Cells(sIndex).EntireRow.Columns("A:I").Value
        End If
    Next r
    
    Worksheets("Lobs-skabelon").Range("A3").Select

    Application.ScreenUpdating = True
    
    MsgBox "Worksheet rows updated.", vbInformation

End Sub