Lọc mã duy nhất và tính tổng (1 người xem)

[thuanntk]

Chào các bạn!
Mình có bảng chi tiết về nhân viên bán hàng hằng ngày, mình nhờ các bạn viết VBA để lọc mã duy nhất và tổng hợp số lượng và doanh thu theo nhân viên ở Sheet "Tổng hợp".Cảm ơn các bạn nhiều

 

[dhn46]

Bạn chuyển qua .xls được không?

 

[Hai Lúa Miền Tây]

Chào các bạn!
Mình có bảng chi tiết về nhân viên bán hàng hằng ngày, mình nhờ các bạn viết VBA để lọc mã duy nhất và tổng hợp số lượng và doanh thu theo nhân viên ở Sheet "Tổng hợp".Cảm ơn các bạn nhiều

Dạng bài này dùng Pivot ngon luôn, sao bạn không dùng nó mà viết code chi cho nhọc.

 

[hoamattroicoi]

Chào các bạn!
Mình có bảng chi tiết về nhân viên bán hàng hằng ngày, mình nhờ các bạn viết VBA để lọc mã duy nhất và tổng hợp số lượng và doanh thu theo nhân viên ở Sheet "Tổng hợp".Cảm ơn các bạn nhiều

Mình không biết VBA, mình làm giúp bạn bằng công thức được không? hihihi
@dhn46 : Bạn cài phần mềm Format Converter nhé để đọc file của office 2007. Search trên google rất nhiều.

 

[Hai Lúa Miền Tây]

Muốn dùng code thì tôi làm cho bạn = ADO luôn

Sub Tong_HLMT()
  Dim cn As Object, adoRS As Object
  Set cn = CreateObject("ADODB.Connection")
  Set adoRS = CreateObject("ADODB.Recordset")
  On Error GoTo BaoLoi
        With cn
            .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                                           "Data Source=" & ThisWorkbook.FullName & _
                                           ";Extended Properties=""Excel 8.0;HDR=No;"";"
            .Open
        End With
        With adoRS
            .ActiveConnection = cn
            .Open "SELECT F1,F2,F3,SUM(F4), Sum(F5) FROM [Chi tiet$B2:F65000] " & _
                      "GROUP BY F1,F2,F3 " & _
                      "HAVING SUM(F5) >0"
        End With
        With Sheets("Tong_ADO")
            .Range("A2:F65000").ClearContents
            .Range("B2").CopyFromRecordset adoRS
                With .Range("A2:A" & .Range("B65000").End(xlUp).Row)
                       .FormulaR1C1 = "=ROW()-1"
                       .Value = .Value
                End With
            .Activate
        End With
        adoRS.Close: cn.Close
        Set cn = Nothing: Set adoRS = Nothing
    Exit Sub
BaoLoi:
MsgBox Err.Description

End Sub

 

[thuanntk]

Muốn dùng code thì tôi làm cho bạn = ADO luôn

Sub Tong_HLMT()
  Dim cn As Object, adoRS As Object
  Set cn = CreateObject("ADODB.Connection")
  Set adoRS = CreateObject("ADODB.Recordset")
  On Error GoTo BaoLoi
        With cn
            .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                                           "Data Source=" & ThisWorkbook.FullName & _
                                           ";Extended Properties=""Excel 8.0;HDR=No;"";"
            .Open
        End With
        With adoRS
            .ActiveConnection = cn
            .Open "SELECT F1,F2,F3,SUM(F4), Sum(F5) FROM [Chi tiet$B2:F65000] " & _
                      "GROUP BY F1,F2,F3 " & _
                      "HAVING SUM(F5) >0"
        End With
        With Sheets("Tong_ADO")
            .Range("A2:F65000").ClearContents
            .Range("B2").CopyFromRecordset adoRS
                With .Range("A2:A" & .Range("B65000").End(xlUp).Row)
                       .FormulaR1C1 = "=ROW()-1"
                       .Value = .Value
                End With
            .Activate
        End With
        adoRS.Close: cn.Close
        Set cn = Nothing: Set adoRS = Nothing
    Exit Sub
BaoLoi:
MsgBox Err.Description

End Sub

Em cảm ơn anh. nhưng code của anh vẫn chưa chạy được. anh xem lại giúp em được không?

 

[thuanntk]

Bạn chuyển qua .xls được không?

Mình gửi bạn file đã chuyển xls. bạn viết VBA giúp mình nha

 

[Quang_Hải]

Mình gửi bạn file đã chuyển xls. bạn viết VBA giúp mình nha

Tham gia 1 code cho vui

Sub tong()
Dim d As Object, dl(), i As Long, k As Long, j As Long, kq()
Set d = CreateObject("scripting.dictionary")
With Sheets("Chi tiet")
    dl = .Range(.[B2], .[F65536].End(3)).Value
End With
ReDim kq(1 To UBound(dl), 1 To 5)
For i = 1 To UBound(dl)
    If Not d.exists(dl(i, 1)) Then
        k = k + 1
        d.Add dl(i, 1), k
        For j = 1 To 5
            kq(k, j) = dl(i, j)
        Next
    Else
        kq(d.Item(dl(i, 1)), 4) = kq(d.Item(dl(i, 1)), 4) + dl(i, 4)
        kq(d.Item(dl(i, 1)), 5) = kq(d.Item(dl(i, 1)), 5) + dl(i, 5)
    End If
Next
Sheets("Tong hop").[A2:E10000].ClearContents
Sheets("Tong hop").[A2].Resize(k, 5) = kq
End Sub

 

[Hai Lúa Miền Tây]

Em cảm ơn anh. nhưng code của anh vẫn chưa chạy được. anh xem lại giúp em được không?

Vậy lổi chổ nào vậy bạn?

 

[nguyenmanhnam]

Dạng bài này dùng Pivot ngon luôn, sao bạn không dùng nó mà viết code chi cho nhọc.

Bác kéo thả thế nào để ra kết quả vậy, em kéo mãi nhưng không được. Nó chỉ được như file đính kèm thôi, xin được nhờ trợ giúp

 

[nguyenmanhnam]

Em rất muốn học Pivot table, kính mong mọi người giúp đỡ./.

----------

Em làm được rồi ah (hóa ra khi chưa đọc Giáo trình của thày Ptm0412 em chưa biết sử dụng Field).

 

[Hai Lúa Miền Tây]

Bác kéo thả thế nào để ra kết quả vậy, em kéo mãi nhưng không được. Nó chỉ được như file đính kèm thôi, xin được nhờ trợ giúp

Bạn xem đoạn phim bên dưới nhé.
[video=youtube_share;jUAK_R-LLqU]http://youtu.be/jUAK_R-LLqU[/video]