Giúp viết code so sánh 2 bảng dữ liệu

Chia sẻ bởi:hands

★★★★★

‹ Tách Tên_Họ_Tên đệm Biến tự thay đổi khi chạy vòng... ›

Quảng cáo

Hi các anh/chị.
Mình có 2 dữ liệu lấy từ 2 nguồn khác nhau nên khác định dạng, giờ cần kiểm tra trong sheet 1 cột A xem tên công ty có xuất hiện trong sheet 2 chưa, nếu đã có thì thêm vào sheet 1 cột C và D tên khách và tên người chăm sóc trong sheet 2, chưa có thì bỏ trắng.
Nhờ mọi người xem và hướng dẫn em với ạ.

Tạo sheet ChuyenDoi và nhập tay các từ viết theo các dạng khác nhau về cùng 1 dạng, bạn tự nhập thêm các từ mới vào phía dưới, không được để ô trống chen giữa
Hy vong code xử lý được hơn 95 % trường hợp

Option Explicit
Option Compare Text
Sub XYZ()
  Dim arr(), aSale(), aVolume(), dic As Object
  Dim sRow&, sr&, i&, r&, ik&, tmp$

Set dic = CreateObject("scripting.dictionary")
  dic.CompareMode = 1
  With Sheets("Chuyendoi")
    arr = .Range("B2:C" & .Range("B" & Rows.Count).End(xlUp).Row).Value
  End With
  sRow = UBound(arr)

With Sheets("Sale")
    aSale = .Range("A2", .Range("B" & Rows.Count).End(xlUp)).Value
  End With
  For i = 1 To UBound(aSale)
    tmp = aSale(i, 1)
    For r = 1 To sRow
      If InStr(1, tmp, arr(r, 1)) > 0 Then
        tmp = Replace(tmp, arr(r, 1), arr(r, 2))
      End If
    Next r
    dic(tmp) = i
  Next i
  With Sheets("Volume")
    aVolume = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value
  End With
  sr = UBound(aVolume)
  ReDim res(1 To sr, 1 To 2)
  For i = 1 To sr
    tmp = aVolume(i, 1)
    If dic.exists(tmp) Then
      ik = dic(tmp)
      res(i, 1) = aSale(ik, 1)
      res(i, 2) = aSale(ik, 2)
    Else
      For r = 1 To sRow
        If InStr(1, tmp, arr(r, 1)) > 0 Then
          tmp = Replace(tmp, arr(r, 1), arr(r, 2))
        End If
      Next r
      If dic.exists(tmp) Then
        ik = dic(tmp)
        res(i, 1) = aSale(ik, 1)
        res(i, 2) = aSale(ik, 2)
      End If
    End If
  Next i
  Sheets("Volume").Range("C2").Resize(sr, 2) = res
End Sub