So Sánh 2 mảng. Mong Anh/Chị giúp đỡ.

[alias1313]

Em cần tổng hợp công của công nhân từ nhiều sheet khác nhau( 3 sheet).

Vì vậy em muốn có thể dùng mảng để so sánh tìm ra tên công nhân giống nhau từ 3 sheet rồi + số công lại.
( Em cũng không biết trường hợp này dùng mảng có đúng không )
Nhưng đến phần so sánh code báo lỗi do: Ubound(Arr3) = 0, em không biết tại sao.

Mong các Anh giúp đỡ, em cũng đang muốn tìm hiểu thêm về mảng.

Em cám ơn. Em có đình kèm theo file.

Sub SOSANH()
Dim sheet As Worksheet
Dim rg1 As Range
Dim rg2 As Range
Dim Arr1() As Variant
Dim Arr2() As Variant
Dim Arr3() As Variant

Application.ScreenUpdating = False

Arr1 = Array(ActiveWorkbook.Sheets("Sheet1").Range("B4:B19"))

Arr2 = Array(ActiveWorkbook.Sheets("Sheet2").Range("C4:C22"))
Arr3 = Array(ActiveWorkbook.Sheets("Sheet3").Range("B3:B32"))
For j = 1 To UBound(Arr3)
If Arr1(j)= Arr3(j)  Then
ActiveWorkbook.Sheets("TINHCONG").Range("B7").Offset(i, 0).Value = Arr1(j)
Next i
End If
Next j
  Application.ScreenUpdating = True
End Sub

 

[HieuCD]

Sub LOC() ' dang tinh
Dim NV1(), Cong1(), NV2(), Cong2(), kq()
Dim i As Long, j As Long, k As Long, ik As Long
Application.ScreenUpdating = False

Dim dic As Object, key As String
Set dic = CreateObject("Scripting.dictionary")
 
NV1 = ThisWorkbook.Sheets("CONG1").Range("C13:C175").Value
Cong1 = ThisWorkbook.Sheets("CONG1").Range("W13:X190").Value

NV2 = ThisWorkbook.Sheets("CONG2").Range("B7:C100").Value
Cong2 = ThisWorkbook.Sheets("CONG2").Range("CW7:CX100").Value

ReDim kq(1 To UBound(NV1, 1) + UBound(NV2, 1), 1 To 6)
' Kiem tra gán keys vào dic
For i = 1 To UBound(NV2)
  key = NV2(i, 1)
  If Len(key) > 0 Then                                                  ' bo cell rong
    If Not dic.exists(key) Then
      dic.Add key, i                                                                ' gán key, item chua có vào dic
    End If
  End If
Next i
'===================================

For i = 1 To UBound(NV1)
   key = NV1(i, 1)                                                                 ' gan keys cho NV1
  If Len(key) > 0 Then
    If Not dic.exists(key) Then                                            ' kiem tra xem keys da co trong dic chua?
      dic.Add key, 0                                                                     ' gan keys, items neu trong dic chua co
      k = k + 1
      kq(k, 1) = key
      kq(k, 3) = Cong1(i, 1)
      kq(k, 4) = Cong1(i, 2)
    Else
      ik = dic.Item(key)                                               ' neu trong dic co key roi, lay item cua key do. ( item nay cua NV2, vi key gan vao dic la key cua NV2)
      If ik > 0 Then                                                       ' Kiem tra xem co item k, neu co thi chay tiep, ko co thi end if
        If Cong2(ik, 1) <> Cong1(i, 1) Or Cong2(ik, 2) <> Cong1(i, 2) Then     ' so sanh công, bang cach so sanh items tuong ung cua NV2 va NV1
          k = k + 1                                                       ' moi gia tri cua k la 1 dong cua vung ket qua,xac dinh dong nay  de gán ket qua tim duoc(thoa DK) vao _
                                                                                  khong quan trong thu tu truoc sau, chi la xac dinh vung de chua ket qua
                               
          kq(k, 1) = NV2(ik, 1)   ' ten NV2
          kq(k, 2) = NV2(ik, 2)   ' Cot 2 cua arry NV2
          kq(k, 3) = Cong1(i, 1)  ' công V NV1
          kq(k, 4) = Cong1(i, 2)   ' Công V3 NV1
          kq(k, 5) = Cong2(ik, 1)  ' Công V NV2
          kq(k, 6) = Cong2(ik, 2)   'Công V3 NV2
     
          End If
        End If
      End If
    End If
 
Next i


ThisWorkbook.Sheets("CONG").UsedRange.Clear                                          ' xóa Sheet("CONG") truoc khi add ket qua
ThisWorkbook.Sheets("CONG").Range("B7").Resize(k, 6).Value = kq     ' Resize vung = voi vung kq, de gán kq

MsgBox "ok"
Application.ScreenUpdating = True

End Sub

Em dịch code theo sự hiểu của mình, anh xem giúp em vậy đã hiểu đúng chưa nha anh!
Em thấy code này độc đáo nhất ở chỗ:

For i = 1 To UBound(NV1)
   key = NV1(i, 1)

lấy tên key của NV2 đặt cho NV1.
giá trị của '"ik" nằm trong vòng for của NV1, nhưng dùng để xác định NV2, CONG2 ==> vì keys, items trong dic là key của NV2.
Khi so sánh để tìm tên trùng nhau của NV1 và NV2, em phải dùng hàm If để so sánh(rất phức tạp),
anh lại so sánh bằng cách kiểm tra xem NV1 có trong dic chưa ==> chỗ này quả thật vi diệu, thể hiện rõ cái hay của dic và người áp dụng.
Đọc xong code của anh em hiểu ra 1 điều trong lập trình ngoài đi theo cấu trúc căn bản của câu lệnh, ta còn phải áp dụng nó bằng tư duy logic của bản thân để sử dụng hết cái hay của nó.

Cám ơn các anh vì sự giúp đỡ, cám ơn vì sự tận tâm!

key chỉ là biến tạm là Mã nhân viên bảng 1 và 2, dùng biến key để dể nhận biết tác dụng trong Dic và các lệnh sau gọn hơn, có thể dùng trực tiếp NV1(i, 1), NV2(i, 1)

Đầu tiên xét bảng 2:
key = NV2(i, 1)
...
dic.Add key, i
Gán tên nhân viên vào key và thứ tự dòng của bảng 2 vào Item của Dic

Xét bảng 1:
key = NV1(i, 1) 'xét tên nhân viên của bảng 1
If Not dic.exists(key) Then 'nhân viên bảng 1 không trùng với bảng 2 không
nếu không trùng, gán vào Dic với Item=0, chỉ gán kết 1 lần, đề phòng nhân viên trong NV1 bị trùng
dic.Add key, 0 ' gan keys, items neu trong dic chua co
k = k + 1 'thứ tự dòng của bảng kết quả
kq(k, 1) = key
kq(k, 3) = Cong1(i, 1)
kq(k, 4) = Cong1(i, 2)
nếu trùng
ik = dic.Item(key) ' thứ tự dòng của bảng 2
If ik > 0 Then ' chỉ xét thứ tự dòng của bảng 2, loại trường hợp bảng 1(ik=0)

 

[VetMini]

Đọc xong code của anh em hiểu ra 1 điều trong lập trình ngoài đi theo cấu trúc căn bản của câu lệnh, ta còn phải áp dụng nó bằng tư duy logic của bản thân để sử dụng hết cái hay của nó.

Trật lất. Lập trình giống như sửa xe máy, chỉ cần chú ý và kinh nghiệm. Chả có cái tư duy nào hơn cái việc cẩn thận từng dòng một.
Quan trọng nhất là 2 điểm:

1. Cách diễn tả vấn đề cho rõ ràng, rành mạch. Vấn đề một khi đã được phân tích rành mạch rồi thì chỉ việc dịch ra code. Chỗ nào bí cũng dễ hỏi.

2. Chỗ nào sai, báo lỗi thì nhớ chính xác chỗ đó. Thứ nhất là có thế mới debug được. Thứ hai là có đúng chỗ đem ra hỏi ngừoi khác ngừoi ta mới biết mà giải thích.
Ngay từ đầu bài, chỗ VBA báo sai bạn cũng nhìn nhầm, còn tư duy thế quái nào nữa.

 

[alias1313]

key chỉ là biến tạm là Mã nhân viên bảng 1 và 2, dùng biến key để dể nhận biết tác dụng trong Dic và các lệnh sau gọn hơn, có thể dùng trực tiếp NV1(i, 1), NV2(i, 1)

Đầu tiên xét bảng 2:
key = NV2(i, 1)
...
dic.Add key, i
Gán tên nhân viên vào key và thứ tự dòng của bảng 2 vào Item của Dic

Xét bảng 1:
key = NV1(i, 1) 'xét tên nhân viên của bảng 1
If Not dic.exists(key) Then 'nhân viên bảng 1 không trùng với bảng 2 không
nếu không trùng, gán vào Dic với Item=0, chỉ gán kết 1 lần, đề phòng nhân viên trong NV1 bị trùng
dic.Add key, 0 ' gan keys, items neu trong dic chua co
k = k + 1 'thứ tự dòng của bảng kết quả
kq(k, 1) = key
kq(k, 3) = Cong1(i, 1)
kq(k, 4) = Cong1(i, 2)
nếu trùng
ik = dic.Item(key) ' thứ tự dòng của bảng 2
If ik > 0 Then ' chỉ xét thứ tự dòng của bảng 2, loại trường hợp bảng 1(ik=0)

Em cám ơn anh!

 

[alias1313]

Trật lất. Lập trình giống như sửa xe máy, chỉ cần chú ý và kinh nghiệm. Chả có cái tư duy nào hơn cái việc cẩn thận từng dòng một.
Quan trọng nhất là 2 điểm:

1. Cách diễn tả vấn đề cho rõ ràng, rành mạch. Vấn đề một khi đã được phân tích rành mạch rồi thì chỉ việc dịch ra code. Chỗ nào bí cũng dễ hỏi.

2. Chỗ nào sai, báo lỗi thì nhớ chính xác chỗ đó. Thứ nhất là có thế mới debug được. Thứ hai là có đúng chỗ đem ra hỏi ngừoi khác ngừoi ta mới biết mà giải thích.
Ngay từ đầu bài, chỗ VBA báo sai bạn cũng nhìn nhầm, còn tư duy thế quái nào nữa.

Hihi....em cám ơn anh đã góp ý.

 

[alias1313]

Giờ em gặp 1 vấn đề mới. khi em so sánh 2 mảng có các phần tử là chuỗi, nó hay bị lỗi ko so sanh được.
Kiểu như là so sánh 2 tên giống nhau: Nguyễn văn A ở mảng 1 và Nguyễn văn A ở mảng 2 nhưng nó ko cho là giống nên nó bỏ qua.
em đã kiểm tra chính tả, định dạng giống nhau y hệt, nó vẫn lỗi.
Em chuyển hướng qua sử dụng mã nhân Viên kiểu: BA - 235, BA-127, để so sánh nó vẫn bị y chang vậy.
giờ em muốn lọc BA -235( là 1 phần tử mảng) lấy số 235 thì làm bằng cách nào ạ.

Mong các anh giúp em, để em kiểm tra tiếp xem được không ạ.
Em cám ơn nhiều!

 

[dhn46]

Giờ em gặp 1 vấn đề mới. khi em so sánh 2 mảng có các phần tử là chuỗi, nó hay bị lỗi ko so sanh được.
Kiểu như là so sánh 2 tên giống nhau: Nguyễn văn A ở mảng 1 và Nguyễn văn A ở mảng 2 nhưng nó ko cho là giống nên nó bỏ qua.
em đã kiểm tra chính tả, định dạng giống nhau y hệt, nó vẫn lỗi.
Em chuyển hướng qua sử dụng mã nhân Viên kiểu: BA - 235, BA-127, để so sánh nó vẫn bị y chang vậy.
giờ em muốn lọc BA -235( là 1 phần tử mảng) lấy số 235 thì làm bằng cách nào ạ.

Mong các anh giúp em, để em kiểm tra tiếp xem được không ạ.
Em cám ơn nhiều!

Bạn đã hỏi nhiều bài rồi mà không đưa luôn file + code bạn làm mọi người xem cho đỡ mất công đoán.

 

[alias1313]

Sub LOC() ' dang tinh
Dim NV1(), Cong1(), NV2(), Cong2(), kq()
Dim i As Long, j As Long, k As Long, ik As Long
Application.ScreenUpdating = False

Dim dic As Object, key as string
Set dic = CreateObject("Scripting.dictionary")
 
NV1 = ThisWorkbook.Sheets("CONG1").Range("C13:C190").Value
Cong1 = ThisWorkbook.Sheets("CONG1").Range("W13:X190").Value

NV2 = ThisWorkbook.Sheets("CONG2").Range("B7:C100").Value
Cong2 = ThisWorkbook.Sheets("CONG2").Range("CW7:CX100").Value

ReDim kq(1 To UBound(NV1, 1) + UBound(NV2, 1), 1 To 6)

For i = 1 To UBound(NV2)
  Key = NV2(i, 1)
  If Len(Key) > 0 Then  ' bo cell rong
    If Not dic.exists(Key) Then
      dic.Add Key, i
    End If
  End If
Next i

For i = 1 To UBound(NV1)
  Key = NV1(i, 1)
  If Len(Key) > 0 Then  ' bo cell rong
    If Not dic.exists(Key) Then
      dic.Add Key, 0
      k = k + 1
      kq(k, 1) = Key
      kq(k, 3) = Cong1(i, 1)
      kq(k, 4) = Cong1(i, 2)
    Else
      ik = dic.Item(Key)
      If ik > 0 Then
        If Cong2(ik, 1) <> Cong1(i, 1) Or Cong2(ik, 2) <> Cong1(i, 2) Then
          k = k + 1
          kq(k, 1) = NV2(ik, 1)
          kq(k, 2) = NV2(ik, 2)
          kq(k, 3) = Cong1(i, 1)
          kq(k, 4) = Cong1(i, 2)
          kq(k, 5) = Cong2(ik, 1)
          kq(k, 6) = Cong2(ik, 2)
        End If
      End If
    End If
  End If
Next i

ThisWorkbook.Sheets("CONG").UsedRange.Clear
ThisWorkbook.Sheets("CONG").Range("B7").Resize(k, 6).Value = kq

MsgBox "ok"
Application.ScreenUpdating = True

End Sub

@dhn46 Em cám ơn anh đã góp ý.

Em đã nghĩ ra rồi, có row, column thì sẽ có địa chỉ cell. đôi khi mình nghĩ phức tạp quá, nó ko ra ^_^..

 

[hoasuajp]

Em chào các anh chị trong GPE, em cũng đang có 1 bài liên quan đến so sánh 2 mảng. mong các anh chị giải đáp giúp ạ.
bài toán:
- cho 2 mảng ở 2 sheet khác nhau, một mảng theo chiều ngang và 1 mảng theo chiều dọc.
- mảng chiều dọc ở sheet("bang1") có số lượng dòng lớn hơn(do merge cell) nhưng giá trị thì tương đương với mảng ngang ở sheet("bang2").
giờ so sánh 2 mảng này và xuất ra msgbox các giá trị không trùng lặp với tên ở sheet"bang1".
Có phải mình transpose mảng ở bài 2 rồi so sánh không ạ?
Mong các anh chị chỉ bảo ạ. Em có gửi file đính kèm ạ

 

[SA_DQ]

Cách khác xíu, nè:

Sub SoSanh2Mang()
 Dim Rng As Range, sRng As Range, Cls As Range
 Dim Rws As Long
 
 With Sheets("Bang1")
    Rws = .UsedRange.Rows.Count
    Set Rng = .UsedRange.Resize(2 * Rws)
 End With
 Sheets("Bang2").Select
 For Each Cls In Range([M7], [M7].End(xlToRight))
    Cls.Interior.ColorIndex = 38
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        If Cls.Offset(1).Value = sRng.Offset(, -1).Value Then
            Cls.Interior.ColorIndex = 35
            MsgBox sRng.Offset(, -1).Value
        End If   
    Else
        Cls.Interior.ColorIndex = 36
    End If
 Next Cls
End Sub

 

[hoasuajp]

Cách khác xíu, nè:

Sub SoSanh2Mang()
 Dim Rng As Range, sRng As Range, Cls As Range
 Dim Rws As Long
 
 With Sheets("Bang1")
    Rws = .UsedRange.Rows.Count
    Set Rng = .UsedRange.Resize(2 * Rws)
 End With
 Sheets("Bang2").Select
 For Each Cls In Range([M7], [M7].End(xlToRight))
    Cls.Interior.ColorIndex = 38
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        If Cls.Offset(1).Value = sRng.Offset(, -1).Value Then
            Cls.Interior.ColorIndex = 35
            MsgBox sRng.Offset(, -1).Value
        End If  
    Else
        Cls.Interior.ColorIndex = 36
    End If
 Next Cls
End Sub

Xuất ra thông báo bị nhầm thì phải ạ, tức là em muốn chia ra trường hợp, đúng thì chuyển tới 1 sub khác chẳng hạn còn sai thì ra thông báo-các giá trị có tên không giống nhau được xuất ra msgbox 1 lần luôn ấy ạ.

 

[SA_DQ]

Mình thấy trong file của bạn có rất nhiều macro & chúng xịn lắm nữa;
Vậy thì bạn tùy biến thử macro của mình trước đi.
& chúc thành công!

 

[hoasuajp]

Mình thấy trong file của bạn có rất nhiều macro & chúng xịn lắm nữa;
Vậy thì bạn tùy biến thử macro của mình trước đi.
& chúc thành công!

Em cám ơn anh nhiều ạ.

 

[BuiQuangThuan]

giờ so sánh 2 mảng này và xuất ra msgbox các giá trị không trùng lặp với tên ở sheet"bang1".

Đọc chưa hiểu chỗ này. Bạn có thể mô tả thêm được không. Nếu có thể mình sẽ vọc vạch thử

 

[hoasuajp]

Đọc chưa hiểu chỗ này. Bạn có thể mô tả thêm được không. Nếu có thể mình sẽ vọc vạch thử

Như thế này ạ : em muốn lọc qua các giá trị trong 2 mảng và so sánh chúng, nếu trường hợp giống nhau hết thì thêm thao tác khác hoặc gọi sub khác, còn nếu khác nhau (ví dụ sheet bang1 tên Nga : không đạt nhưng sheet bang2 lại đạt thì ra thông báo là dữ liệu chưa trùng khớp tại chỗ tên Nga ấy ạ, thay vì thông báo từng người thì em muốn lọc 1 lần thông báo tất cả luôn ạ -thông báo đây là msgbox ạ)

 

[BuiQuangThuan]

Như thế này ạ : em muốn lọc qua các giá trị trong 2 mảng và so sánh chúng, nếu trường hợp giống nhau hết thì thêm thao tác khác hoặc gọi sub khác, còn nếu khác nhau (ví dụ sheet bang1 tên Nga : không đạt nhưng sheet bang2 lại đạt thì ra thông báo là dữ liệu chưa trùng khớp tại chỗ tên Nga ấy ạ, thay vì thông báo từng người thì em muốn lọc 1 lần thông báo tất cả luôn ạ -thông báo đây là msgbox ạ)

Thử. hên xui. Trúng thì trúng còn không thì trượt

Sub ABC()
Dim sArr(), Dic As Object, Tmp, i&
Set Dic = CreateObject("scripting.dictionary")
With Sheets("bang1")
    sArr = .Range("C5:D" & .Range("C" & Rows.Count).End(3).Row).Value
    For i = 1 To UBound(sArr)
        If sArr(i, 1) <> Empty Then
            Dic.Item(sArr(i, 2) & "|" & sArr(i, 1)) = i
        End If
    Next
End With
With Sheets("bang2")
    sArr = .Range("M7:Z8").Value
    For i = 1 To UBound(sArr, 2)
        Key = sArr(1, i) & "|" & sArr(2, i)
        If Dic.exists(Key) = False Then
            If Len(Tmp) > 0 Then Tmp = Tmp & vbCrLf & Key Else Tmp = Key
        End If
    Next
End With
MsgBox Tmp
End Sub

 

[hoasuajp]

Cảm ơn a @SA_DQ , code của anh nhìn đơn giản nhưng thực ra không như em nghĩ, chắc tại chưa đạt được trình độ thượng thừa như anh.Hì. Em có sửa đôi chút để ra được kết quả thích hợp, bạn nào cần tham khảo cũng có thể dùng ạ.

Sub SoSanh2Mang()
 Dim Rng As Range, sRng As Range, Cls As Range
 Dim Rws As Long
 Dim bien As String
 
 With Sheets("Bang1")
    Rws = .UsedRange.Rows.count
    Set Rng = .UsedRange.Resize(2 * Rws)
 End With
 Sheets("Bang2").Select
 For Each Cls In Range([M7], [M7].End(xlToRight))
    Cls.Interior.ColorIndex = 38
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        If Cls.Offset(1).Value = sRng.Offset(, -1).Value Then
            Cls.Interior.ColorIndex = 35
            'MsgBox sRng.Offset(, 0).Value
       ' End If
    Else
        'Cls.Interior.ColorIndex = 36
        bien = bien + sRng.Offset(, 0).Value
    End If
    End If
 Next Cls
        MsgBox bien
End Sub

Cám ơn anh @BuiQuangThuan ạ, code đã chạy ok, chỉ cần khai báo thêm key nữa là được ạ.
Cám ơn các anh nhiều lắm ạ, em sẽ mò từ từ để hiểu rõ hơn code của 2 anh.hì

 

[hoasuajp]

Em có thắc mắc mong anh @SA_DQ giải đáp cho :
- Tại sao lại

 Set Rng = .UsedRange.Resize(2 * Rws)

để làm gì ạ? em kiểm tra thì nó là range $C$5:$D$78
- Và khi

if Cls.Offset(1).Value = sRng.Offset(, -1).Value Then

thì so sánh giá trị 2 mảng hay sao ạ.
Em mò mẫm cả chiều mà chưa ra.

 

[VetMini]

...
- mảng chiều dọc ở sheet("bang1") có số lượng dòng lớn hơn(do merge cell) nhưng giá trị thì tương đương với mảng ngang ở sheet("bang2").
giờ so sánh 2 mảng này và xuất ra msgbox các giá trị không trùng lặp với tên ở sheet"bang1".
Có phải mình transpose mảng ở bài 2 rồi so sánh không ạ?
...

Trường hợp này không nên viết code tính toán hay so sánh gì cả.
Bỏ hết merged cells đi rồi hẵn tính.

 

[SA_DQ]

Em có thắc mắc mong anh @SA_DQ giải đáp cho :
(1) - Tại sao lại

 Set Rng = .UsedRange.Resize(2 * Rws)

để làm gì ạ? em kiểm tra thì nó là range $C$5:$D$78
(2)- Và khi

if Cls.Offset(1).Value = sRng.Offset(, -1).Value Then

thì so sánh giá trị 2 mảng hay sao ạ.
Em mò mẫm cả chiều mà chưa ra.

(1) Xài phương thức FIND() khi có trộn ô theo cột thì phải lấy dư Rng (vùng để tìm kiếm); Nếu không làm vậy thì giá trị cuối trong vùng tìm kiếm sẽ không bao giờ được tìm thấy.
(2) 1 khi tìm thấy thì phải đối chiếu xem chuyện xếp loại đã được ấn định đúng hay sai
Chúc các bạn vui!

 

[bebo021999]

Tên "Minh " trong bang2 có khoảng trắng phía sau. Delete đi nhé.
Không biết các code phía trên có kiểm tra tên thừa, thiếu giữa 2 bảng chưa, đoạn code phía dưới sẽ kiểm tra và ra thông báo các trường hợp sau:
- Bang1 bị trùng tên
- Bang2 bị trùng tên
- Bang2 bị thiếu tên so với bảng 1
- Bang2 bị thừa tên so với bảng 1

Option Explicit
Sub sosanh()
Dim lr&, lc&, i&, count&, rng, dic As Object, key, st As String, st2 As String
Set dic = CreateObject("Scripting.dictionary")
With Worksheets("bang1")
    lr = .Cells(Rows.count, "C").End(xlUp).Row
    rng = .Range("C5:D" & lr).Value
    For i = 1 To lr - 4
        If Not IsEmpty(rng(i, 2)) Then
            If Not dic.exists(rng(i, 2)) Then
                dic.Add rng(i, 2), rng(i, 1) ' tao danh sach ten trong bang1
            Else
                MsgBox "Chú ý! Trùng tên: " & """" & rng(i, 2) & """" & " trong bang1. Kiem tra lai" ' hien thong bao neu bang 1 bi trung ten
                Exit Sub
            End If
        End If
    Next
End With
With Worksheets("bang2")
    lc = .Cells(7, Columns.count).End(xlToLeft).Column
    rng = .Range("M7", .Cells(8, lc)).Value
    For Each key In dic.keys
        count = 0
        For i = 1 To lc - 12
            If rng(1, i) = key Then
                count = count + 1
                If count > 1 Then
                    MsgBox "Chú ý! Trùng tên:" & """" & key & """" & "  trong bang2. Kiem tra lai" ' hien thong bao neu bang 2 bi trung ten
                    Exit Sub
                End If
                If rng(2, i) <> dic(key) Then st = st & vbLf & key ' duyet qua tung ten trong bang2, neu trung ten ma khac KQ thì ghep chuoi
            End If
        Next
        If count = 0 Then ' hien thong bao neu bang2 bi thieu ten trong bang1
            MsgBox "Chú ý! bang2 bi thieu ten: " & """" & key & """"
            Exit Sub
        End If
    Next
    For i = 1 To lc - 12
        count = 0
        For Each key In dic.keys
            If rng(1, i) = key Then ' doi chieu tung ten trong bang2 voi bang1 xem co ten nao bi thua khong
                count = count + 1
                Exit For
            End If
        Next
        If count = 0 Then st2 = st2 & vbLf & rng(1, i) ' danh sach ten bang2 khong co trong bang1
    Next
    If Len(st2) > 0 Then
        MsgBox " Chú ý! Bang2 thua ten so voi bang1: " & vbLf & st2 ' hien thong bao neu bang2 bi thua ten so voi bang1
        Exit Sub
    End If
End With
MsgBox " Danh sach ten khong khop: " & vbLf & st
End Sub