Tìm lỗi sai trong code "Scripting.Dictionary", do đặt biến tạm thay thế

[AnhThu-1976]

Xuất phát từ bài học "Scripting.Dictionary" cơ bản
Em có tập viết code, Vì code có một số biến dài và thấy anh chị cũng đặt biến tạm nên cũng đặt theo, nhưng code của em cho kết quả sai
Cụ thể code chạy đúng là

Sub Cau_2()
    Dim Dic1 As Object, iRow As Long, i As Long
    Dim Arr() As Variant, TmpArr As Variant
    With Sheets("Cau1")
       .Range("E40:H100").ClearContents
        Set Dic1 = CreateObject("Scripting.Dictionary")

        TmpArr = Sheets("Cau1").Range("B2:G21").Value
        ReDim Arr(1 To UBound(TmpArr, 1), 1 To 6)

        For iRow = 1 To UBound(TmpArr, 1)
            If Not IsEmpty(TmpArr(iRow, 2)) And Not Dic1.exists(TmpArr(iRow, 2)) Then
                i = i + 1
                Dic1.Add TmpArr(iRow, 2), i
                Arr(i, 1) = TmpArr(iRow, 1)
                Arr(i, 2) = TmpArr(iRow, 2)
                If TmpArr(iRow, 3) <> "" Then
                    Arr(i, 3) = TmpArr(iRow, 6)

                Else
                    Arr(i, 4) = TmpArr(iRow, 6)
                End If
            Else
                If TmpArr(iRow, 3) <> "" Then
                    Arr(Dic1.Item(TmpArr(iRow, 2)), 3) = Arr(Dic1.Item(TmpArr(iRow, 2)), 3) + TmpArr(iRow, 6)
                Else
                    Arr(Dic1.Item(TmpArr(iRow, 2)), 4) = Arr(Dic1.Item(TmpArr(iRow, 2)), 4) + TmpArr(iRow, 6)

                End If
            End If
        Next iRow
        .Range("E40").Resize(i, 4).Value = Arr
    End With
End Sub

Còn code của em sau khi chế là

Sub Cau_2_CheBien()
    Dim Dic1 As Object, iRow As Long, i As Long, a As String, b As Long
    Dim Arr() As Variant, TmpArr As Variant
    With Sheets("Cau1")
        .Range("J40:M100").ClearContents
        Set Dic1 = CreateObject("Scripting.Dictionary")

        TmpArr = Sheets("Cau1").Range("B2:G21").Value
        ReDim Arr(1 To UBound(TmpArr, 1), 1 To 6)

        For iRow = 1 To UBound(TmpArr, 1)
             a = TmpArr(iRow, 2) 'taòo biêìn taòm a ðêÒ thay thêì TmpArr(iRow, 2) do noì daÌi
             
            If Not IsEmpty(TmpArr(iRow, 2)) And Not Dic1.exists(a) Then
            
                i = i + 1
               
                '''Dic1.Add TmpArr(iRow, 2), i  ''boÒ doÌng naÌy thay thêì = doÌng dýõìi
                Dic1.Add a, i ' doÌng naÌy thay thêì doÌng trên
                Arr(i, 1) = TmpArr(iRow, 1)
                Arr(i, 2) = TmpArr(iRow, 2)
                If TmpArr(iRow, 3) <> "" Then
                    Arr(i, 3) = TmpArr(iRow, 6)

                Else
                    Arr(i, 4) = TmpArr(iRow, 6)
                End If
            Else
                If TmpArr(iRow, 3) <> "" Then
                    b = Dic1.Item(a) 'taòo biêìn taòm b ðêÒ thay thêì Dic1.Item(TmpArr(iRow, 2)) do noì daÌi
                    ''''Arr(Dic1.Item(TmpArr(iRow, 2)), 3) = Arr(Dic1.Item(TmpArr(iRow, 2)), 3) + TmpArr(iRow, 6)
                    Arr(b, 3) = Arr(b, 3) + TmpArr(iRow, 6) ' doÌng naÌy thay thêì doÌng trên
                Else
                    ''''''Arr(Dic1.Item(TmpArr(iRow, 2)), 4) = Arr(Dic1.Item(TmpArr(iRow, 2)), 4) + TmpArr(iRow, 6)
                    Arr(b, 4) = Arr(b, 4) + TmpArr(iRow, 6) ' doÌng naÌy thay thêì doÌng trên

                End If
            End If
        Next iRow
        .Range("J40").Resize(i, 4).Value = Arr
    End With
End Sub

Kết quả sai trong file là
Cột M sai so với cột H
Code chế của em có giải thích trong code
Nhờ anh/chị giải thích ạ, em cảm ơn!

 

[CHAOQUAY]

@AnhThu-1976
Lỗi là trong trường hợp TmpArr(iRow, 3) = "", b không được gán giá trị mới -> giá trị b sẽ được lấy của dòng so sánh liền trước

Chuyển câu lệnh gán b=... ra ngoài lệnh IF() -> trong bất kỳ trường hợp TmpArr(iRow, 3) rỗng hoặc không, b đều cho giá trị của item(a) hiện tại
Sửa đoạn code trên thành như bên dưới

If TmpArr(iRow, 3) <> "" Then
    b = Dic1.Item(a) 'taòo biêìn taòm b ðêÒ thay thêì Dic1.Item(TmpArr(iRow, 2)) do noì daÌi
    ''''Arr(Dic1.Item(TmpArr(iRow, 2)), 3) = Arr(Dic1.Item(TmpArr(iRow, 2)), 3) + TmpArr(iRow, 6)
    Arr(b, 3) = Arr(b, 3) + TmpArr(iRow, 6) ' doÌng naÌy thay thêì doÌng trên
Else
    'Loi tai day, b khong duoc gan gia tri moi
    ''''''Arr(Dic1.Item(TmpArr(iRow, 2)), 4) = Arr(Dic1.Item(TmpArr(iRow, 2)), 4) + TmpArr(iRow, 6)
    Arr(b, 4) = Arr(b, 4) + TmpArr(iRow, 6) ' doÌng naÌy thay thêì doÌng trên
End If

b = Dic1.Item(a) 'taòo biêìn taòm b ðêÒ thay thêì Dic1.Item(TmpArr(iRow, 2)) do noì daÌi
If TmpArr(iRow, 3) <> "" Then
    'b = Dic1.Item(a) 'taòo biêìn taòm b ðêÒ thay thêì Dic1.Item(TmpArr(iRow, 2)) do noì daÌi
    ''''Arr(Dic1.Item(TmpArr(iRow, 2)), 3) = Arr(Dic1.Item(TmpArr(iRow, 2)), 3) + TmpArr(iRow, 6)
    Arr(b, 3) = Arr(b, 3) + TmpArr(iRow, 6) ' doÌng naÌy thay thêì doÌng trên
Else
    ''''''Arr(Dic1.Item(TmpArr(iRow, 2)), 4) = Arr(Dic1.Item(TmpArr(iRow, 2)), 4) + TmpArr(iRow, 6)
    Arr(b, 4) = Arr(b, 4) + TmpArr(iRow, 6) ' doÌng naÌy thay thêì doÌng trên
End If

 

[AnhThu-1976]

Cảm ơn bạn @CHAOQUAY nhiều!