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

[thuanntk]

Chào mọi người!
Mình có sheet "chi tiết" chứa hàng mua và bán, nhờ các bạn viết VBA để tách riêng hàng mua với điều kiện lọc những ngày và tên hàng trùng nhau thì tính tổng và sắp xếp theo ngày. Còn hàng bán chỉ sắp xếp theo ngày.Cảm ơn các bạn

 

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

Chào mọi người!
Mình có sheet "chi tiết" chứa hàng mua và bán, nhờ các bạn viết VBA để tách riêng hàng mua với điều kiện lọc những ngày và tên hàng trùng nhau thì tính tổng và sắp xếp theo ngày. Còn hàng bán chỉ sắp xếp theo ngày.Cảm ơn các bạn

Bạn dùng code sau nhé:
[GPECODE=sql]Sub TongHop()
Dim cn As Object, rst As Object
Dim strSQL As String
Set cn = CreateObject("ADODB.Connection")
With cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
.Open
End With
strSQL = "SELECT F2,F3,SUM(F5),SUM(F7),SUM(F8),SUM(F9) " & _
"FROM [Chi tiet$A5:J20] " & _
"WHERE F4='Mua' " & _
"GROUP BY F2,F3 "
Set rst = cn.Execute(strSQL)
With Sheet2
.[B4:J100].ClearContents
.[B4].CopyFromRecordset rst
End With
rst.Close
strSQL = "SELECT F2,F3,F5,F6,F7,F8,F9 " & _
"FROM [Chi tiet$A5:J20] " & _
"WHERE F4='Bán' " & _
"ORDER BY F2,F3 "
Set rst = cn.Execute(strSQL)
With Sheet2
.[J4100].ClearContents
.[J4].CopyFromRecordset rst
End With
rst.Close: cn.Close
Set rst = Nothing: Set cn = Nothing

End Sub

[/GPECODE]

 

[HyperLink]

Chào mọi người!
Mình có sheet "chi tiết" chứa hàng mua và bán, nhờ các bạn viết VBA để tách riêng hàng mua với điều kiện lọc những ngày và tên hàng trùng nhau thì tính tổng và sắp xếp theo ngày. Còn hàng bán chỉ sắp xếp theo ngày.Cảm ơn các bạn

thêm 1 cách nữa nhé ,
- vào sheet Tong hop chọn C3 (mua hoặc bán) và click lọc ... (code đang tận dụng chức năng Advanced Filter)
- công thức tại nhóm bán bạn làm tương tự.

Option Explicit

Private Sub CommandButton1_Click() 'loc mua, ban
Dim vungloc As Range, dk_CopyToRange As Range
    
    Set vungloc = ThisWorkbook.Sheets("chi tiet").Range("A5:J1000")

    If Range("C3") = "mua" Then
        Set dk_CopyToRange = ActiveSheet.Range("B6:C6")
    Else
        Set dk_CopyToRange = ActiveSheet.Range("J6:K6")
    End If
    
    vungloc.AdvancedFilter Action:=xlFilterCopy, _
                        CriteriaRange:=Range("B2:C3"), _
                        CopyToRange:=dk_CopyToRange, _
                        Unique:=True
        
End Sub

 

[VetMini]

@Hai Lúa Miền Tây:
Code của bạn query xong là đưa results recordset vào vùng kết quả. Vậy thì đâu có cần phải lấy nó ra một biến. Bạn có thể đưa thẳng kết quả của query vào vùng kết quả:

    With Sheet2
        .[B4:J100].ClearContents
        .[B4].CopyFromRecordset cn.Execute( _
            " SELECT F2,F3,SUM(F5),SUM(F7),SUM(F8),SUM(F9) " & _
             " FROM [Chi tiet$A5:J20] WHERE F4='Mua' " & _
             " GROUP BY F2,F3 ")
             
        .[J4:P100].ClearContents
        .[J4].CopyFromRecordset cn.Execute( _
            " SELECT F2,F3,F5,F6,F7,F8,F9 " & _
             " FROM [Chi tiet$A5:J20] WHERE F4='Bán' " & _
             " ORDER BY F2,F3 " _
            )
    End With