Sub DictionaryFilter()
Dim Dic As Object
Dim i As Long, lRow As Long, ArrData(), Result(), sKey As String, j As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
lRow = .Range("B" & Rows.Count).End(xlUp).Row
ArrData = .Range("B2:D" & lRow).Value2
lRow = UBound(ArrData, 1)
ReDim Result(1 To lRow, 1 To 4)
For i = 1 To lRow
sKey = ArrData(i, 1) & "|" & ArrData(i, 2)
If sKey <> "" Then
If Not Dic.Exists(sKey) Then
j = j + 1
Dic.Add sKey, j
Result(j, 1) = j
Result(j, 2) = ArrData(i, 1)
Result(j, 3) = ArrData(i, 2)
Result(j, 4) = ArrData(i, 3)
Else
Result(Dic.Item(sKey), 4) = Result(Dic.Item(sKey), 4) + ArrData(i, 3)
End If
End If
Next i
If j > 0 Then
.Range("H2").Resize(100, 4).ClearContents
.Range("H2").Resize(j, 4) = Result
End If
End With
End SubĐúng là em cần thế này rồi ạ ! Em cảm ơn anh nhiều !
Từ phiên bản excel 2016 thì PQ là tool có sẵn.
Thế thì chịu rồi. PQ là 1 tool, thêm được thì tốt. Kết hợp được cả VBA thì song kiếm hợp hợp tích càng mạnh mẽ hơn thôi.Tôi mua bản quyền 2013 cứng theo máy. Chờ cái máy hư, sắm máy khác mới đổi bộ Office được
O2013 không biết đã có power pivot chưa anh nhỉ? Nếu không có thì cũng đáng phải upgrade thật.
Vâng anh, thực tế mà có 5, 7 bảng liên kết với nhau thì làm báo cáo dùng nó cũng đỡ mệt hơn chút.
1. Bạn đang dùng bộ Office năm nào? như có trao đổi ở trên, từ phiên bản 2016 thì Power Query có sẵn, còn trở về trước cần cài thêm Addin.
Anh thấy kết quả ví dụ nó khác với câu lệnh em viết, anh tạm chỉnh như sau:
= Table.Group(#"Changed Type", {"Code"}, {{"Quantity", each List.Sum([Quantity]), type nullable number}, {"Date", each List.Min([Date]), type nullable date}})Sub Gop_HLMT()
With CreateObject("ADODB.Connection")
.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0")
Sheet1.Range("M2").CopyFromRecordset .Execute("Select [Code], Min([Date]), Sum(Quantity) From [ArrayList$] where [Code] Is Not Null Group By [Code]")
End With
End SubCảm ơn anh,
Để làm thuần trong SQL phải dựa vào dữ liệu và hợi phức tạp. Có thể kết hợp với VBA để đánh số cho nó.
Vậy em bổ sung thêm thế này:
Sub Gop_HLMT()
With CreateObject("ADODB.Connection")
.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0")
Sheet1.Range("S2").CopyFromRecordset .Execute("Select [Code], Min([Date]), Sum(Quantity) From [ArrayList$] where [Code] Is Not Null Group By [Code]")
If Sheet1.Range("S2") <> "" Then Sheet1.Range([S2], [S65536].End(3)).Offset(, -1) = [row(a:a)]
End With
End Sub
