Xem và sửa giúp đoạn code khớp dữ liệu theo mã cho trước (1 người xem)

[Tran Mui]

Nhờ GPE giúp đoạn code sau sai chỗ nào , mà khi khớp dữ liệu phần lớn kết quả đúng, nhưng một số chõ vẫn sai ( file ví dụ đính kèm)
Xin cám ơn
Sub KhopPhach()
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual
End With
Dim endR&, i&, j&
Dim sPhach$, sTmp$
Dim Arr(), ArrPh()
With Sheets("THop")
endR = .Cells(65000, 10).End(xlUp).Row
ArrPh = .Range("j7:l" & endR).Value
End With
With Sheets("In_ketqua")
endR = .Cells(65000, 10).End(xlUp).Row
Arr = .Range("j7:l" & endR).Value
End With
For i = 1 To UBound(Arr)
sPhach = CStr(Arr(i, 9) & Arr(i, 10))
For j = 1 To UBound(ArrPh)
sTmp = CStr(ArrPh(j, 1) & ArrPh(j, 2))
If Len(sTmp) > 0 Then
If sPhach = sTmp Then
Arr(i, 11) = ArrPh(j, 3)
GoTo Exit_For
End If
End If
Next j
Exit_For:
Next i
With Sheets("In_ketqua")
.[B7].Resize(UBound(Arr), 11) = Arr
End With
Erase Arr(), ArrPh()
With Application
.ScreenUpdating = True: .Calculation = xlCalculationAutomatic
End With
End Sub

 

[nmhung49]

Bạn hãy để ý dòng 56,57,58 bên sheet THop của bạn thì sẽ rõ khi bạn dùng nối chuổi nó sẽ hiểu dòng đó là T221; T222; T223 v...vv.. tương đương bên sheet In_KQ của bạn dòng 8; 9; 10 để chắc chắn không bị trường hợp đó bạn nên nối chuỗi bên 1 lần nữa và có nhiều cách lắm mình dùng nối chuỗi 1 lần nữa để đảm bảo không trùng mà mình không hiểu Arr = .Range("j7:l" & endR).Value chỉ có nhiêu thôi mà lấy đâu là Arr(i,11), Arr(i, 9), Arr(i, 10). Mình sửa sơ cho bạn mà đùng Post bài nhiều nơi nhen bạn Nhờ GPE sửa giúp Code cho công việc khớp dữ liệu theo mã cho trước

Sub KhopPhach()
Dim endR&, i&, j&
Dim sPhach$, sTmp$
Dim Arr(), ArrPh()
With Application
  .ScreenUpdating = False: .Calculation = xlCalculationManual
With Sheets("THop")
  endR = .Cells(65000, 10).End(xlUp).Row
  ArrPh = .Range("j7:l" & endR).Value
End With
With Sheets("In_ketqua")
  endR = .Cells(65000, 10).End(xlUp).Row
  Arr = .Range("j7:l" & endR).Value
End With
For i = 1 To UBound(Arr)
  sPhach = CStr(Arr(i, 1) & Arr(i, 1) & Arr(i, 2))
  For j = 1 To UBound(ArrPh)
    sTmp = CStr(ArrPh(j, 1) & ArrPh(j, 1) & ArrPh(j, 2))
    
    If Len(sTmp) > 0 Then
      If sPhach = sTmp Then
        Arr(i, 3) = ArrPh(j, 3)
        GoTo Exit_For
      End If
    End If
  Next j
Exit_For:
Next i
With Sheets("In_ketqua")
  .[j7].Resize(UBound(Arr), 3) = Arr
End With
  .ScreenUpdating = True: .Calculation = xlCalculationAutomatic
End With
Erase Arr(), ArrPh()
End Sub