Nhờ các anh chị code 1 macro lấy số liệu ở 3 sheet vào 1 sheet (1 người xem)

[datvba]

Em có file dữ liệu như đính kèm.Nhờ mọi người code dùm 1 macro để tổng hợp. Cám ơn ạ

 

[ChanhTQ@]

Bạn thử xài macro như dưới đây

Trước đó bạn đến ô [AA1] thuộc trang 'TAISANHIENCO' & nhập vô đó công thức =A1;
Ô liền kề bên fải ta nhập CT =C1

Private Sub CommandButton1_Click()
 Dim ShB As Worksheet, ShT As Worksheet, ShS As Worksheet, WF As Object
 Dim Rws As Long, Jj As Long, Col As Byte
 
 Set ShB = ThisWorkbook.Worksheets("BOITHUONG")
 Set ShT = ThisWorkbook.Worksheets("TAISANHIENCO")
 Set ShS = ThisWorkbook.Worksheets("SOTIENKHOIKIEN")
 Set WF = Application.WorksheetFunction
 Rws = ShB.[B2].CurrentRegion.Rows.Count
 [B6].Resize(9 * Rws, 11).ClearContents
 
 ReDim Arr(2 To Rws + 2, 1 To 11)
 For Jj = 2 To Rws
    Arr(Jj, 1) = ShB.Cells(Jj, "A")             'MaKH'
    Arr(Jj, 2) = ShB.Cells(Jj, "C")             'CMND'
    Arr(Jj, 3) = ShB.Cells(Jj, "B")             'H&T'
    Arr(Jj, 4) = WF.VLookup(Arr(Jj, 1), ShS.[c1].CurrentRegion, 3, False)   'DCh'
    Arr(Jj, 5) = WF.VLookup(Arr(Jj, 1), ShS.[c1].CurrentRegion, 5, False)   'SoT'
    Arr(Jj, 6) = WF.VLookup(Arr(Jj, 1), ShS.[c1].CurrentRegion, 4, False)   'FL'
    ShT.[aa2].Value = Arr(Jj, 1)
    For Col = 7 To 9
        ShT.[ab2].Value = Cells(5, Col + 1)
        Arr(Jj, Col) = WF.DSum(ShT.[B2].CurrentRegion, ShT.[d1], ShT.[AA1:AB2])  'TSn'
        Arr(Jj, 10) = Arr(Jj, 10) + Arr(Jj, Col)
    Next Col
    Arr(Jj, 11) = ShB.Cells(Jj, "D")            'BT'
 Next Jj
 [B6].Resize(Jj, 11).Value = Arr()
End Sub

 

[datvba]

Macro của anh em chạy thử, nhưng mà không cộng tổng số tiền vì 1 khách hàng có nhiều số tiền ở sheet sotienkhoikien, và các cột h i j k cũng ko có số liệu ạ.

 

[SA_DQ]

/-(ình như bạn chưa kịp làm cái vụ này thì fải:

Trước đó bạn đến ô [AA1] thuộc trang 'TAISANHIENCO' & nhập vô đó công thức =A1;
Ô liền kề bên fải ta nhập CT  =C1

 

[datvba]

Em đã làm đúng như thế, chỉ còn cột số tiền (cột F) của sheet TONGHOP vẫn không cộng tổng được. Cột số tiền là tổng cộng số tiền theo khách hàng ở cột E của sheet SOTIENKHOIKIEN. Ví dụ khách hàng Trần Minh có số tiền đúng là 80.000.

 

[Ba Tê]

Em đã làm đúng như thế, chỉ còn cột số tiền (cột F) của sheet TONGHOP vẫn không cộng tổng được. Cột số tiền là tổng cộng số tiền theo khách hàng ở cột E của sheet SOTIENKHOIKIEN. Ví dụ khách hàng Trần Minh có số tiền đúng là 80.000.

Thử với code "Củ chuối" này xem:

Public Sub GPE()
Application.ScreenUpdating = False
Dim Rng(), Arr(), I As Long, K As Long, Dic As Object, Tem As Variant, TS As Long, Cll As Range
Set Dic = CreateObject("Scripting.Dictionary")
    Rng = Sheets("BOITHUONG").Range(Sheets("BOITHUONG").[A2], Sheets("BOITHUONG").[A65000].End(xlUp)).Resize(, 4).Value
ReDim Arr(1 To UBound(Rng, 1), 1 To 12)
        For K = 1 To UBound(Rng, 1)
            Dic.Add (Rng(K, 1)), K
            Arr(K, 1) = K: Arr(K, 2) = Rng(K, 1): Arr(K, 3) = Rng(K, 3)
            Arr(K, 4) = Rng(K, 2): Arr(K, 12) = Rng(K, 4)
        Next K
    Rng = Sheets("SOTIENKHOIKIEN").Range(Sheets("SOTIENKHOIKIEN").[A2], Sheets("SOTIENKHOIKIEN").[E65000].End(xlUp)).Value
        For I = 1 To UBound(Rng, 1)
            Tem = Rng(I, 1)
            Arr(Dic.Item(Tem), 5) = Rng(I, 3)
            Arr(Dic.Item(Tem), 6) = Arr(Dic.Item(Tem), 6) + Rng(I, 5)
            Arr(Dic.Item(Tem), 7) = Rng(I, 4)
        Next I
    Rng = Sheets("TAISANHIENCO").Range(Sheets("TAISANHIENCO").[A2], Sheets("TAISANHIENCO").[D65000].End(xlUp)).Value
    With Sheets("TONGHOP")
        For I = 1 To UBound(Rng, 1)
            If Rng(I, 3) = .[H5].Value Then TS = 8
            If Rng(I, 3) = .[I5].Value Then TS = 9
            If Rng(I, 3) = .[J5].Value Then TS = 10
                Tem = Rng(I, 1)
                Arr(Dic.Item(Tem), TS) = Arr(Dic.Item(Tem), TS) + Rng(I, 4)
                Arr(Dic.Item(Tem), 11) = Arr(Dic.Item(Tem), 11) + Rng(I, 4)
        Next I
        .[A6:L1000].ClearContents
        .[A6:L1000].Interior.ColorIndex = 0
        .[A6].Resize(K - 1, 12).Value = Arr
         Set Cll = .[E65000].End(xlUp).Offset(2)
         Cll.Value = .[J1].Value
         Cll.Offset(, 1).Value = "=SUM(R6C:R[-2]C)"
         Cll.Offset(, -4).Resize(, 12).Interior.ColorIndex = 6
        For I = 3 To 7
            Cll.Offset(, I).Value = "=SUM(R6C:R[-2]C)"
        Next I
    End With
Set Dic = Nothing: Set Cll = Nothing
Application.ScreenUpdating = True
End Sub