Tính tổng số tiền theo từng khách hàng (1 người xem)

[tnfsmith]

Mình có yêu cầu bằng VBA như đề gửi
Chi tiết như file đính kèm.
Xin cám ơn!

 

[xuan.nguyen82]

Mình có yêu cầu bằng VBA như đề gửi
Chi tiết như file đính kèm.
Xin cám ơn!

Ý bạn muốn như thế này phải không?
(Bạn mở file và bấm nút "Tong hop")

 

[xuan.nguyen82]

Chủ nhân top đã bấm "cẻm ơn" chắc là đúng ý rùi!

 

[chuot0106]

Mình có yêu cầu bằng VBA như đề gửi
Chi tiết như file đính kèm.
Xin cám ơn!

Mở File nhấn nút tổng hợp và xem kết quả nhé!

Public Sub tonghop()
Dim i As Long, n As Long, data(), kq()
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
data = Sheet1.Range("B3:B" & Sheet1.Range("B65500").End(xlUp).Row).Resize(, 6)
ReDim kq(1 To UBound(data), 1 To 3)


For i = 1 To UBound(data)
    If Not Dic.Exists(data(i, 1)) Then
        j = j + 1
        Dic.Add data(i, 1), j
        kq(j, 1) = data(i, 1)
        kq(j, 2) = data(i, 2)
        kq(j, 3) = data(i, 6)
    Else
        n = Dic.Item(data(i, 1))
        kq(n, 3) = kq(n, 3) + data(i, 6)
    End If
Next i
        Sheet2.Range("B7").Resize(j, 3) = kq
        Sheet2.Range("B6").Resize(j + 1, 3).Borders.LineStyle = xlContinuous
End Sub

 

[chuot0106]

Thêm phần đánh STT.

Public Sub tonghop()
Dim i As Long, n As Long, data(), kq()
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
data = Sheet1.Range("B3:B" & Sheet1.Range("B65500").End(xlUp).Row).Resize(, 6)
ReDim kq(1 To UBound(data), 1 To 4)


For i = 1 To UBound(data)
    If Not Dic.Exists(data(i, 1)) Then
        j = j + 1
        Dic.Add data(i, 1), j
        kq(j, 1) = j
        kq(j, 2) = data(i, 1)
        kq(j, 3) = data(i, 2)
        kq(j, 4) = data(i, 6)
    Else
        n = Dic.Item(data(i, 1))
        kq(n, 4) = kq(n, 4) + data(i, 6)
    End If
Next i
        Sheet2.Range("A7").Resize(j, 4) = kq
        Sheet2.Range("A6").Resize(j + 1, 4).Borders.LineStyle = xlContinuous
End Sub

 

[Kiều Mạnh]

Thêm phần đánh STT.

Public Sub tonghop()
Dim i As Long, n As Long, data(), kq()
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
data = Sheet1.Range("B3:B" & Sheet1.Range("B65500").End(xlUp).Row).Resize(, 6)
ReDim kq(1 To UBound(data), 1 To 4)


For i = 1 To UBound(data)
    If Not Dic.Exists(data(i, 1)) Then
        j = j + 1
        Dic.Add data(i, 1), j
        kq(j, 1) = j
        kq(j, 2) = data(i, 1)
        kq(j, 3) = data(i, 2)
        kq(j, 4) = data(i, 6)
    Else
        n = Dic.Item(data(i, 1))
        kq(n, 4) = kq(n, 4) + data(i, 6)
    End If
Next i
        Sheet2.Range("A7").Resize(j, 4) = kq
        Sheet2.Range("A6").Resize(j + 1, 4).Borders.LineStyle = xlContinuous
End Sub

Thêm biến J nữa bạn nếu người ta ko dành về code chạy là lỗi. cảm ơn chuot0106 và xuan.nguyen82 code viết rất gọn và dễ hiểu

 

[Quang_Hải]

Thêm biến J nữa bạn nếu người ta ko dành về code chạy là lỗi. cảm ơn chuot0106 và xuan.nguyen82 code viết rất gọn và dễ hiểu

Xem quái chiêu đây. Mấy chiêu hay mọi người xài hết rồi, mình ghiền quá nên cố theo kiểu chả giống ai

Sub QuaiChieu()
[B6].Consolidate "'Chi tiet'!R2C2:R65536C7", 9, 1, 1
Sheet1.[C2:C10000].AdvancedFilter 2, , [C6], 1
Range([D6], [D65536].End(3)).Resize(, 3).Delete
Range([D7], [D65536].End(3)).Offset(, -3) = [row(a:a)]
[B6].CurrentRegion.Borders.Value = 1
End Sub

 

[Kiều Mạnh]

Xem quái chiêu đây. Mấy chiêu hay mọi người xài hết rồi, mình ghiền quá nên cố theo kiểu chả giống ai

Sub QuaiChieu()
[B6].Consolidate "'Chi tiet'!R2C2:R65536C7", 9, 1, 1
Sheet1.[C2:C10000].AdvancedFilter 2, , [C6], 1
Range([D6], [D65536].End(3)).Resize(, 3).Delete
Range([D7], [D65536].End(3)).Offset(, -3) = [row(a:a)]
[B6].CurrentRegion.Borders.Value = 1
End Sub

đúng là code bang chủ loạn cào cào quái thiệt. dòng này mới quái lạ "[B6].Consolidate "'Chi tiet'!R2C2:R65536C7", 9, 1, 1" chưa thấy ai viết bao giờ

 

[Ngoai Thanh]

Thêm một tý nữa cho vui :

Sub loc()
Dim n As Long
Sheet1.[A2:C10000].AdvancedFilter 2, Sheet1.[A2:A3], Sheet3.[B2], Unique:=True
n = Sheet3.Range("B65536").End(xlUp).Row
Sheet3.Range("D3").Formula = "=SUMIF('Chi tiet'!R3C2:R18C2,Sheet1!RC2,'Chi tiet'!R3C7:R18C7)"
Sheet3.Range("D3" & n).Value = [D3].Formula
With Range("D3" & n)
.Value = .Value
End With
[D2] = "T" & ChrW(7893) & "ng l" & ChrW(361) & "y k" & ChrW(7871)
[A2] = "TT"
[A3] = 1
Range("A3:A" & n).DataSeries
Range("A2" & n).Borders.LineStyle = xlContinuous
End Sub

 

[Cá ngừ F1]

Xem quái chiêu đây. Mấy chiêu hay mọi người xài hết rồi, mình ghiền quá nên cố theo kiểu chả giống ai

Sub QuaiChieu()
[B6].Consolidate "'Chi tiet'!R2C2:R65536C7", 9, 1, 1
Sheet1.[C2:C10000].AdvancedFilter 2, , [C6], 1
Range([D6], [D65536].End(3)).Resize(, 3).Delete
Range([D7], [D65536].End(3)).Offset(, -3) = [row(a:a)]
[B6].CurrentRegion.Borders.Value = 1
End Sub

Các từ khóa a Hải viết quả thật quái chiêu, theo tìm hiểu ở help

expression.Consolidate(Sources, Function, TopRow, LeftColumn, CreateLinks)

Nhân tiện các con số Function a giải mã cho anh em GPE học hỏi ạ. Ví dụ: số 9 e đang hiểu là hàm sumif?

 

[Kiều Mạnh]

Các từ khóa a Hải viết quả thật quái chiêu, theo tìm hiểu ở help

Nhân tiện các con số Function a giải mã cho anh em GPE học hỏi ạ. Ví dụ: số 9 e đang hiểu là hàm sumif?

Mình khoái máy vụ quái quái này lắm ...các bạn Ai có có độc chiêu nào kỳ quái nữa không úp lên cho mọi người học với
xin cảm ơn

 

[sealand]

Xem quái chiêu đây. Mấy chiêu hay mọi người xài hết rồi, mình ghiền quá nên cố theo kiểu chả giống ai

Sub QuaiChieu()
[B6].Consolidate "'Chi tiet'!R2C2:R65536C7", 9, 1, 1
Sheet1.[C2:C10000].AdvancedFilter 2, , [C6], 1
Range([D6], [D65536].End(3)).Resize(, 3).Delete
Range([D7], [D65536].End(3)).Offset(, -3) = [row(a:a)]
[B6].CurrentRegion.Borders.Value = 1
End Sub

Đúng là quái chiêu, các chức năng tích hợp sẵn của Excel như pivot, consolidate... bao giờ cũng cho tốc độ nhanh hơn nhiều so với VBA. Tận dụng được nó sẽ có lợi hơn khi sử lý dữ liệu lớn.

Để cổ súy, mình cũng mạn phép Modify cách viết của Quang Hải 1 chút để dễ tham khảo

Sub QuaiChieu1()
[b6].Consolidate Sheet1.Name & "!R2C2:R65536C7", 9
Sheet1.[C2:C10000].AdvancedFilter 2, , [C6], 1
With Range([b6], [b65536].End(3))
[A7].Resize(.Rows.Count - 1) = [row(1:65000)]
.Offset(, 4).Resize(, 2).Cut [D6]
.CurrentRegion.Borders.Value = 1
End With
End Sub

 

[tnfsmith]

Thật ngưỡng mộ xin cám ơn tất cả