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

 

[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 ạ.