时间戳

首页 > 解决方案 > 复制与金额和发票编号匹配的行

excel - 复制与金额和发票编号匹配的行

问题描述

我有一个 Excel 工作簿，其中有两张名为 sheet1 和 sheet2 sheet 1 和 sheet 2 都有 3 列 A、B、C 表 1 填充了所有列中的数据，但在表 2 中，“c”列为空我想要一个 VBA 代码所以它的 macthes 表 2 的 A 和 B 列值与 sheet1 的相应列匹配，如果找到匹配，则更新 sheet2 中的列“C”。

更新：我更新了我的代码，所以我正在做的是将工作表 1“dataBase”中的 AH 列与 Sheet2“Payment_Invoice_Inward”的 K 列相匹配，并更新 AL 上的结果，但我无法添加第二个条件以便它匹配数据库表的AE列的值到Payment_Invoice_Inward的Q列，在每行满足这两个条件后，才复制和更新

Sub UpdateW232()
Application.Visible = True
Dim w1 As Worksheet, w2 As Worksheet
Dim c As Range, FR As Long


Application.ScreenUpdating = False
Set w1 = ThisWorkbook.Sheets("DataBase")
Set w2 = ThisWorkbook.Sheets("Payment_Invoice_Inward")


For Each c In w1.Range("AH2", w1.Range("AH" & Rows.Count).End(xlUp))
    FR = 0
    On Error Resume Next
    FR = Application.Match(c, w2.Columns("K"), 0)
    On Error GoTo 0
    If FR <> 0 Then w2.Range("AL" & FR).value = c.Offset(, -5)
Next c
Application.ScreenUpdating = True

结束子

标签： excelvba

解决方案

你没有问我问题...

所以，请尝试下一个代码。它很快（也适用于大范围），仅在内存中工作并立即删除处理结果，但如果至少其中一个相关工作表具有唯一的对（A：B），它会更快：

Sub testMatchColumns()
 Dim sh1 As Worksheet, sh2 As Worksheet, lastR1 As Long, lastR2 As Long
 Dim arr1 As Variant, arr2 As Variant, i As Long, j As Long
 
 Set sh1 = Worksheets("Sheet1")
 Set sh2 = Worksheets("Sheet2")
 lastR1 = sh1.Range("A" & Rows.count).End(xlUp).Row
 lastR2 = sh2.Range("A" & Rows.count).End(xlUp).Row
 arr1 = sh1.Range("A2:C" & lastR1).Value
 arr2 = sh2.Range("A2:C" & lastR2).Value
 
 For i = 1 To UBound(arr1)
    For j = 1 To UBound(arr2)
        If arr1(i, 1) & arr1(i, 2) = arr2(j, 1) & arr2(j, 2) Then
            arr2(j, 3) = arr1(i, 3)
        End If
    Next j
 Next i
 sh2.Range("A2:C2").Resize(UBound(arr2)).Value = arr2
End Sub

推荐阅读