Dạ, em có làm được đoạn code như bên dưới nhưng có vẻ nó chưa được tối ưu ạ.
With Application
.Interactive = False
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Dim lastrow As Long
Dim MyFile As String
MyPath = "C:\Users\Invoice Excel File - invList2\Exits in InvList1 & InvList2\"
MyFile = Dir(MyPath)
Do While MyFile <> ""
If MyFile Like "*.xlsm" Or MyFile Like "*.xls" Or MyFile Like "*.XLSX" Or MyFile Like "*.xlsx" Or MyFile Like "*.Xlsx" Or MyFile Like "*.Xls" Then
Workbooks.Open MyPath & MyFile
Dim arr, arr1, arr2
Dim i, j As Long
arr = ActiveWorkbook.Sheets("Sheet1").Range("I2:J" & ActiveWorkbook.Sheets("Sheet1").Range("I" & Rows.Count).End(xlUp).Row).Value
arr1 = Sheet1.Range("H2:Z" & Sheet1.Range("H" & Rows.Count).End(xlUp).Row).Value
ReDim arr2(1 To UBound(arr1, 1), 1 To 1)
For i = 1 To UBound(arr1, 1)
For j = 1 To UBound(arr, 1)
If arr1(i, 1) <> "" And arr(j, 1) <> "" And arr1(i, 2) <> "" And arr(j, 2) <> "" Then
If UCase(arr1(i, 1)) = UCase(arr(j, 1)) And UCase(arr1(i, 2)) = UCase(arr(j, 2)) Then
MsgBox "ok"
Sheet1.Range("J1") = "same"
Exit For
End If
End If
Next j
Next i
'Sheet1.Range("J2").Resize(UBound(arr1, 1), 1).Value = arr2
ActiveWorkbook.Close True
End If
MyFile = Dir
Loop
With Application
.Interactive = True
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
