Giúp mình sửa code file quản lý hàng (1 người xem)

[allblue8x]

Hi mọi người, ở Sheet Bảng Tổng Hợp trong file mình đính kèm, sao mình bấm Tổng Hợp những khách hàng phía trên thì ok, nhưng Trí Hòa Hảo và Xưởng thì ko được tổng hợp. Mọi ng giúp mình sửa code lại sao cho tổng hợp tất các khách hàng được không. (Mình sẻ còn nhập vào nhiều khách hàng khác nữa)

Mình cám ơn.

https://www.mediafire.com/?8t1736000lq8rt4

 

[maytinhvp01]

Hi mọi người, ở Sheet Bảng Tổng Hợp trong file mình đính kèm, sao mình bấm Tổng Hợp những khách hàng phía trên thì ok, nhưng Trí Hòa Hảo và Xưởng thì ko được tổng hợp. Mọi ng giúp mình sửa code lại sao cho tổng hợp tất các khách hàng được không. (Mình sẻ còn nhập vào nhiều khách hàng khác nữa)

Mình cám ơn.

https://www.mediafire.com/?8t1736000lq8rt4

With Sheets("TEN KH")
    DSKH = .Range(.[B6], .[B6].End(xlDown)).Value
End With

Mình nghĩ là chỗ này nên không chọn được
Vì mảng bạn lấy là sheet có tên "TEN KH" và tên khách hàng được chứa từ B6-->>B15 trong đó B13 không chứa dữ liệu
vậy với câu lệnh trên bạn chỉ lấy được dữ liệu vào mảng từ B6--->>B12
>>>>>bỏ qua dữ liệu tên khách hàng là đương nhiên
>>>>> bạn tự sửa code nhé!!!

Public Sub LOC_BTH()
Application.ScreenUpdating = False
Dim Dic As Object, DSKH(), sArr(), dArr(), n As Long, i As Long, j As Long, k As Long
Dim rSult(), keyItem
Dim Tem As String, STT As Long, TCong As String, Tong(1 To 1, 1 To 6), Cll As Range
Set Dic = CreateObject("Scripting.Dictionary")
TCong = Sheets("CHITIET_KH").[O5].Value
With Sheets("TEN KH")
   [COLOR=#ff0000] DSKH = .Range(.[B6], .[B6000].End(xlUp)).Value[/COLOR]
End With
With Sheets("NHAP DU LIEU")
    sArr = .Range(.[B6], .[B6].End(xlDown)).Resize(, 13).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 10)
For n = 1 To UBound(DSKH, 1)
    STT = 0
    For i = 1 To UBound(sArr, 1)
        If sArr(i, 1) = DSKH(n, 1) Then
            Tem = sArr(i, 1) & sArr(i, 2) & sArr(i, 3)
            If Not Dic.exists(Tem) Then
                k = k + 1: STT = STT + 1
                Dic.Add Tem, k
                dArr(k, 1) = STT
                For j = 1 To 3
                    dArr(k, j + 1) = sArr(i, j)
                Next j
                dArr(k, 5) = 1
                dArr(k, 6) = sArr(i, 13)
                dArr(k, 8) = "=RC[-2] * (100%-RC[-1])" '====Chinh lai cai nay, bo khong truy xuat cot 7 cua dArr
                dArr(k, 10) = "=RC[-2]*RC[-1]"
            Else
                dArr(Dic.Item(Tem), 5) = dArr(Dic.Item(Tem), 5) + 1
                dArr(Dic.Item(Tem), 6) = dArr(Dic.Item(Tem), 6) + sArr(i, 13)
            End If
        End If
    Next i
    If STT > 0 Then
        k = k + 1
        dArr(k, 3) = TCong
        dArr(k, 5) = "=sum(R[-" & STT & "]C:R[-1]C)"
        dArr(k, 6) = "=sum(R[-" & STT & "]C:R[-1]C)"
        dArr(k, 8) = "=sum(R[-" & STT & "]C:R[-1]C)"
        dArr(k, 10) = "=sum(R[-" & STT & "]C:R[-1]C)"
    End If
Next n


' ========= Thêm cho này ^^
rSult = Sheet4.Range("B5:J" & Sheet4.[J65536].End(xlUp).Row).Value
    For i = 1 To UBound(rSult, 1)
        keyItem = rSult(i, 1) & rSult(i, 2) & rSult(i, 3)
        If Dic.exists(keyItem) Then
            dArr(Dic.Item(keyItem), 9) = rSult(i, 8)
            dArr(Dic.Item(keyItem), 7) = rSult(i, 6)
        End If
    Next
 ' =============Den cho nay


With Sheets("BANG TONG HOP")
    .[A5:J10000].ClearContents
    .[A5:J10000].Borders.LineStyle = xlNone
    .[A5:J10000].Interior.ColorIndex = 0
    If k Then
        .[A5].Resize(k, 10).Value = dArr
        .[A5].Resize(k, 10).Borders.LineStyle = xlContinuous
        For Each Cll In .Range(.[C5], .[C5].End(xlDown))
            If Cll.Value = TCong Then
                Cll.Offset(, -2).Resize(, 10).Interior.ColorIndex = 36
            End If
        Next
    End If
End With
Set Dic = Nothing
Application.ScreenUpdating = True
End Sub

sửa luôn cho bạn!