So Sánh 2 mảng. Mong Anh/Chị giúp đỡ. (1 người xem)

[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

 

[SA_DQ]

Trước tiên là nói về cấu trúc các trang:
Bạn hiện có 3 trang, mỗi trang dữ liệu gồm 02 cột;
Cái tên hiện thời là tiêu đề 2 cột này ở 2 trang khác nhau lại nằm ở các dòng khác nhau.
Chuyện này là bạn tự làm khó cho mình đấy thôi!

Vấn đề nữa trong CSDL ta có tên người (LĐ); Nhưng thường trong xử lí dữ liệu ta không thể xài ngay tới chuỗi họ & tên nữa, chứ nói gì đến tên;
Người ta xài mã duy nhất để CSDL sống đời ở kiếp với bạn; Nếu xài tên như bạn thì chả mấy chốc nó biến thành bãi rác mà thôi.

Trong các công việc tổng hợp công của tháng hay cả quí, năm, ta cần có danh sách toàn thể CNV kể từ đầu năm; Cho dù đã nghỉ làm trước tháng đang thống kê hay mới vô cơ quan.
Danh sách (DS) này bạn đang thiếu
DS này nhất thiết phải có các trường [STT], [Mã NV], [Họ Tên], & các trường khác liên quan đến chế độ, BHXH, thai sản, ốm đau, con ốm hay cho con bú,. . . .
Dò tổng công trong tháng hay các tháng sẽ fải thông qua DS chung này.

Vài í nhỏ góp í cùng bạn, những mong tẹo hữu ích nào đến với bạn & chúc vui!

 

[befaint]

Ubound(Arr3) = 0, em không biết tại sao

"Arr3 = Array(ActiveWorkbook.Sheets("Sheet3").Range("B3:B32"))"
thì biến Arr3 là một biến mảng, mảng 1 chiều, có 1 phần tử.
Mặc khác Option Base 0 (mặc định).
Nên Ubound(Arr3) = 0 là đúng, chuẩn rồi. Không có lỗi gì cả.

 

[alias1313]

Trước tiên là nói về cấu trúc các trang:
Bạn hiện có 3 trang, mỗi trang dữ liệu gồm 02 cột;
Cái tên hiện thời là tiêu đề 2 cột này ở 2 trang khác nhau lại nằm ở các dòng khác nhau.
Chuyện này là bạn tự làm khó cho mình đấy thôi!

Vấn đề nữa trong CSDL ta có tên người (LĐ); Nhưng thường trong xử lí dữ liệu ta không thể xài ngay tới chuỗi họ & tên nữa, chứ nói gì đến tên;
Người ta xài mã duy nhất để CSDL sống đời ở kiếp với bạn; Nếu xài tên như bạn thì chả mấy chốc nó biến thành bãi rác mà thôi.

Trong các công việc tổng hợp công của tháng hay cả quí, năm, ta cần có danh sách toàn thể CNV kể từ đầu năm; Cho dù đã nghỉ làm trước tháng đang thống kê hay mới vô cơ quan.
Danh sách (DS) này bạn đang thiếu
DS này nhất thiết phải có các trường [STT], [Mã NV], [Họ Tên], & các trường khác liên quan đến chế độ, BHXH, thai sản, ốm đau, con ốm hay cho con bú,. . . .
Dò tổng công trong tháng hay các tháng sẽ fải thông qua DS chung này.

Vài í nhỏ góp í cùng bạn, những mong tẹo hữu ích nào đến với bạn & chúc vui!

Em cám ơn Anh! Góp ý của anh rất bổ ích, giúp em có cái nhìn bao quát hơn.

 

[alias1313]

"Arr3 = Array(ActiveWorkbook.Sheets("Sheet3").Range("B3:B32"))"
thì biến Arr3 là một biến mảng, mảng 1 chiều, có 1 phần tử.
Mặc khác Option Base 0 (mặc định).
Nên Ubound(Arr3) = 0 là đúng, chuẩn rồi. Không có lỗi gì cả.

Vậy trong trường hợp này em có thể dùng mảng để lọc không anh! Hay chỉ có 1 cách là dùng vòng lặp for để quét range.
Để so sánh cell trong 2 Range, thì cách tối ưu nhất là gì ạ!
Mong anh giúp đỡ.

 

[VetMini]

Arr3 = Array(ActiveWorkbook.Sheets("Sheet3").Range("B3:B32"))

Array (đỏ) là một hàm, trả về một mảng có phần tử là cái trong tham của nó (xanh). Dùng code trên thì biến Arr3 sẽ là một mảng 1 phần tử, phần tử ấy là cái range B3:B32

Bạn cần xem lại code trước đây ngừoi ta viết về mảng để thấy rõ cách thức chuyển trị trong range sang mảng như thế nào.

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.

Phi lý. Nếu Ubound(Arr3) = 0 thì code trong vòng lặp For j = 1 To UBound(Arr3) không chạy. Phần so sánh đã khong chạy thì lấy gì báo lỗi?

 

[HieuCD]

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

tạo mảng từ Range:
Arr3 = ActiveWorkbook.Sheets("Sheet3").Range("B3:B32").Value

 

[alias1313]

Array (đỏ) là một hàm, trả về một mảng có phần tử là cái trong tham của nó (xanh). Dùng code trên thì biến Arr3 sẽ là một mảng 1 phần tử, phần tử ấy là cái range B3:B32

Bạn cần xem lại code trước đây ngừoi ta viết về mảng để thấy rõ cách thức chuyển trị trong range sang mảng như thế nào.



Phi lý. Nếu Ubound(Arr3) = 0 thì code trong vòng lặp For j = 1 To UBound(Arr3) không chạy. Phần so sánh đã khong chạy thì lấy gì báo lỗi?

Em cũng không hiểu tại sao, cám ơn anh!

 

[alias1313]

tạo mảng từ Range:
Arr3 = ActiveWorkbook.Sheets("Sheet3").Range("B3:B32").Value

Hihi...em cám ơn anh @HieuCD .

Em đang tìm hiểu về mảng để viết code kiểm tra, so sánh dữ liệu: công làm việc trong tháng,
so sánh xem công sau khi cập nhật lên hệ thống có giống với bảng công chấm hàng ngày không( để tránh mất công của công nhân).
em có 2 Sheet: CONG1 và CONG2, trong đó có tên và hai cột chấm công ( V, V3(ca đêm))
Em tạo hai mảng: Arr1 ( dữ liệu sheet(CONG2), Arr2 (CONG1) sau đó:

- Sau đó em so sánh:
+ Nếu Nguyen van A có trong cả Arr1 và Arr2 --->( If (Arr1(i,1) = Arr2(i,2)) thì sẽ so sánh tiếp
2 cột công V và V3 nếu có 1 trong hai cột khác thì chép kết qua ra Sheet(CONG).
+ Nếu cả 2 cột V, V3 giá trị giống nhau thì ko cần làm gì.
- Nhưng em chạy ra kết quả không đúng , có ra tên nhưng V,V3 lại giống nhau.
Mong anh giúp em chỉ ra chỗ sai để em làm tiếp!

Sub LOC() ' dang tinh
Dim sheet As Worksheet
Dim rg1 As Range
Dim rg2 As Range
Dim rg3 As Range
Dim Arr1()
Dim Arr2()
Dim Arr3()
Dim kq()
Dim kq2()

Dim i As Long, j As Long, k1 As Long, k2 As Long


'On Error Resume Next
Application.ScreenUpdating = False

Dim dict As Object
Set dict = CreateObject("Scripting.dictionary")
 
Arr1 = ThisWorkbook.Sheets("CONG2").Range("B7:DN100").Value
Arr2 = ThisWorkbook.Sheets("CONG1").Range("C13:AS190").Value

ReDim kq(1 To UBound(Arr1, 1), 1 To 4)
ReDim kq2(1 To UBound(Arr2, 1), 1 To 4)
With CreateObject("Scripting.dictionary")
For i = 1 To UBound(Arr1)
    If Not dict.exists(Arr1(i, 1)) Then
            k1 = k1 + 1
            dict.Add Arr1(i, 1), k1
         If Len(Arr1(i, 1)) > 0 Then ' bo cell rong
            kq(k1, 1) = Arr1(i, 1)
            kq(k1, 2) = Arr1(i, 2)
            kq(k1, 3) = Arr1(i, 100)
            kq(k1, 4) = Arr1(i, 101)
        
        End If

    End If
 
For j = 1 To UBound(Arr2)
    If Not dict.exists(Arr2(j, 1)) Then
            k2 = k2 + 1
            dict.Add Arr2(j, 1), k2
        If Len(Arr2(j, 1)) > 0 Then ' bo cell rong
 
            kq2(k2, 1) = Arr2(j, 1)
            kq2(k2, 3) = Arr2(j, 21)
            kq2(k2, 4) = Arr2(j, 22)
        End If
    End If



If (Arr1(i, 1) = Arr2(j, 1) And Len(Arr1(i, 1)) > 0) Then
    Debug.Print Arr1(i, 1)
    If (Arr1(i, 100) = Arr2(j, 21)) And _
        (Arr1(i, 101) = Arr2(j, 22)) Then
    Else
        kq(k1, 3) = Arr1(i, 100)
        kq(k1, 4) = Arr1(i, 101)
    
     End If

 
   End If

Next j
Next i
ThisWorkbook.Sheets("CONG").UsedRange.Clear
ThisWorkbook.Sheets("CONG").Range("B7").Resize(k1, 4).Value = kq

End With
MsgBox "ok"
Application.ScreenUpdating = True

End Sub

 

[befaint]

đang tìm hiểu về mảng

Bạn đọc bài này xem...

 

[alias1313]

Bạn đọc bài này xem...

Cám ơn anh!

 

[HieuCD]

Hihi...em cám ơn anh @HieuCD .

Em đang tìm hiểu về mảng để viết code kiểm tra, so sánh dữ liệu: công làm việc trong tháng,
so sánh xem công sau khi cập nhật lên hệ thống có giống với bảng công chấm hàng ngày không( để tránh mất công của công nhân).
em có 2 Sheet: CONG1 và CONG2, trong đó có tên và hai cột chấm công ( V, V3(ca đêm))
Em tạo hai mảng: Arr1 ( dữ liệu sheet(CONG2), Arr2 (CONG1) sau đó:

- Sau đó em so sánh:
+ Nếu Nguyen van A có trong cả Arr1 và Arr2 --->( If (Arr1(i,1) = Arr2(i,2)) thì sẽ so sánh tiếp
2 cột công V và V3 nếu có 1 trong hai cột khác thì chép kết qua ra Sheet(CONG).
+ Nếu cả 2 cột V, V3 giá trị giống nhau thì ko cần làm gì.
- Nhưng em chạy ra kết quả không đúng , có ra tên nhưng V,V3 lại giống nhau.
Mong anh giúp em chỉ ra chỗ sai để em làm tiếp!

Sub LOC() ' dang tinh
Dim sheet As Worksheet
Dim rg1 As Range
Dim rg2 As Range
Dim rg3 As Range
Dim Arr1()
Dim Arr2()
Dim Arr3()
Dim kq()
Dim kq2()

Dim i As Long, j As Long, k1 As Long, k2 As Long


'On Error Resume Next
Application.ScreenUpdating = False

Dim dict As Object
Set dict = CreateObject("Scripting.dictionary")
 
Arr1 = ThisWorkbook.Sheets("CONG2").Range("B7:DN100").Value
Arr2 = ThisWorkbook.Sheets("CONG1").Range("C13:AS190").Value

ReDim kq(1 To UBound(Arr1, 1), 1 To 4)
ReDim kq2(1 To UBound(Arr2, 1), 1 To 4)
With CreateObject("Scripting.dictionary")
For i = 1 To UBound(Arr1)
    If Not dict.exists(Arr1(i, 1)) Then
            k1 = k1 + 1
            dict.Add Arr1(i, 1), k1
         If Len(Arr1(i, 1)) > 0 Then ' bo cell rong
            kq(k1, 1) = Arr1(i, 1)
            kq(k1, 2) = Arr1(i, 2)
            kq(k1, 3) = Arr1(i, 100)
            kq(k1, 4) = Arr1(i, 101)
       
        End If

    End If
 
For j = 1 To UBound(Arr2)
    If Not dict.exists(Arr2(j, 1)) Then
            k2 = k2 + 1
            dict.Add Arr2(j, 1), k2
        If Len(Arr2(j, 1)) > 0 Then ' bo cell rong
 
            kq2(k2, 1) = Arr2(j, 1)
            kq2(k2, 3) = Arr2(j, 21)
            kq2(k2, 4) = Arr2(j, 22)
        End If
    End If



If (Arr1(i, 1) = Arr2(j, 1) And Len(Arr1(i, 1)) > 0) Then
    Debug.Print Arr1(i, 1)
    If (Arr1(i, 100) = Arr2(j, 21)) And _
        (Arr1(i, 101) = Arr2(j, 22)) Then
    Else
        kq(k1, 3) = Arr1(i, 100)
        kq(k1, 4) = Arr1(i, 101)
   
     End If

 
   End If

Next j
Next i
ThisWorkbook.Sheets("CONG").UsedRange.Clear
ThisWorkbook.Sheets("CONG").Range("B7").Resize(k1, 4).Value = kq

End With
MsgBox "ok"
Application.ScreenUpdating = True

End Sub

Sửa code hơi khó, viết mới dể hơn
Ở mỗi sheet tên trùng nhau làm sao biết để so sánh đúng dòng?

 

[alias1313]

Sửa code hơi khó, viết mới dể hơn
Ở mỗi sheet tên trùng nhau làm sao biết để so sánh đúng dòng?

Trùng nhau là do em tao sơ ý, em đã tạo bảng khác không có tên trùng nhau, anh giúp em nha anh!
Em cám ơn anh @HieuCD .

 

[befaint]

không có tên trùng nhau

Sao không thấy mã duy nhất ứng với mỗi người. Không có mã này không dám làm gì tiếp.

+ Nếu Nguyen van A có trong cả Arr1 và Arr2 thì sẽ so sánh tiếp
2 cột công V và V3 nếu có 1 trong hai cột khác thì chép kết qua ra

Có ở một trong hai cột khác là thế nào bạn? Không hiểu.
Giá trị ở 2 cột đó tương ứng khác nhau hả?

Cho vài kết quả làm bằng mắt và tay vào file xem...

 

[HieuCD]

Trùng nhau là do em tao sơ ý, em đã tạo bảng khác không có tên trùng nhau, anh giúp em nha anh!
Em cám ơn anh @HieuCD .

Bảng công 1 vẫn còn trùng

 

[alias1313]

Sao không thấy mã duy nhất ứng với mỗi người. Không có mã này không dám làm gì tiếp.

Có ở một trong hai cột khác là thế nào bạn? Không hiểu.
Giá trị ở 2 cột đó tương ứng khác nhau hả?

Cho vài kết quả làm bằng mắt và tay vào file xem...

Em có 2 bảng chấm công( 1 cái chấm bằng tay, 1 cái chấm bằng máy) tổng hợp 1 tháng/1 lần.
Em cần kiểm tra xem 2 bảng công này có khớp nhau không, bằng cách kiểm tra giá trị ở 2 ô V(công ca ngày), V3(công ca đêm).
Em ví dụ: ------------------------------- Bảng công 1-------------------------------- Bảng công 2
Họ và tên------------------------- --- V---- ---------- V3----------------- -- ---------V ---------- V3
Nguyen van A ------------------------13 ---- --------- 10 -------------------------- -13---------------10 ===> Anh này công chấm đúng, không cần làm gì

Nguyen van B -----------------------13---------------- 9 -----------------------------13 --------------- 10 =====> Anh này chấm sai, 2 bảng công không khớp nhau ( giá trị V3 khác nhau) ===> lọc ra sheet mới)

Trần van C ------------------ ---------9 ------------------ 9 ----------------------- ---11 --------------- 11 =====> Anh này chấm sai, 2 bảng công không khớp nhau ===> lọc ra sheet mới)


Cám ơn anh!

 

[alias1313]

Bảng công 1 vẫn còn trùng

Em đã sửa lại! Cám ơn anh @HieuCD

 

[HieuCD]

Em đã sửa lại! Cám ơn anh @HieuCD

Tạo kết quả 6 cột

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

 

[alias1313]

Tạo kết quả 6 cột

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

Code chạy chính xác và rất nhanh anh ơi. Em cám ơn anh @HieuCD rất nhiều.
Cám ơn các anh đã giúp đỡ!
Chúc các anh một ngày mới mạnh khỏe và vui vẻ! ^_^...

 

[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: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!

 

[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

 

[hoasuajp]

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.

vì merged cells mặc định như vậy nên không bỏ được anh ạ.

Bài đã được tự động gộp: 2/6/22

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

Tuyệt quá, thêm điều kiện để thử, cám ơn anh nhiều ạ.