问用索引匹配(VBA)更新数据库

EN

Sub UpdateDB()

On Error Resume Next
Dim Dept_Row As Long
Dim Dept_Clm As Long

lastrow = ThisWorkbook.Worksheets(Worksheets.Count).Cells(ThisWorkbook.Worksheets(Worksheets.Count).Rows.Count, "C").End(xlUp).Row
lastrowA = ThisWorkbook.Worksheets(Worksheets.Count).Cells(ThisWorkbook.Worksheets(Worksheets.Count).Rows.Count, "A").End(xlUp).Row
lastrowI = Sheet1.Cells(Sheet1.Rows.Count, "I").End(xlUp).Row 
lastrowG = Sheet1.Cells(Sheet1.Rows.Count, "G").End(xlUp).Row 

table1 = ThisWorkbook.Worksheets(Worksheets.Count).Range("C2:C" & lastrow) 
table2 = ThisWorkbook.Worksheets(Worksheets.Count).Range("A2:D" & lastrowA) 
table3 = Sheet1.Range("I2:I" & lastrowI)
table4 = Sheet1.Range("G2:K" & lastrowG)

Dept_Clm = ThisWorkbook.Worksheets(Worksheets.Count).Range("B2").Column
Dept_Row = ThisWorkbook.Worksheets(Worksheets.Count).Range("B2").Row


'Checking for delivery numbers of the filtered table and the new sheet and updating the corresponding remaining quantity
For Each dl In table3
DLfiltered = Application.WorksheetFunction.Index(table4, Application.WorksheetFunction.Match(dl, table3, 0), 3)
DLnewdb = Application.WorksheetFunction.Index(table2, Application.WorksheetFunction.Match(dl, table1, 0), 3)

pcfiltered = Application.WorksheetFunction.Index(table4, Application.WorksheetFunction.Match(dl, table3, 0), 1)
pcnewdb = Application.WorksheetFunction.Index(table2, Application.WorksheetFunction.Match(dl, table1, 0), 1)

remainqty = Application.WorksheetFunction.Index(table4, Application.WorksheetFunction.Match(dl, table3, 0), 5)
Row = Application.WorksheetFunction.Match(dl, table1, 0)


'If the delivery numbers and the product codes are the same, then update quantity
If dlnewdb = dlfiltered And pcfiltered = pcnewdb Then
    ThisWorkbook.Worksheets(Worksheets.Count).Cells(Dept_Row, Dept_Clm) = remainqty
End If

Next CDN

End Sub