Lấy tất cả ngày và có cộng dồn nếu trùng ngày trong Dic (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

hoahuongduong1986

Thành viên thường trực
Tham gia
14/11/18
Bài viết
346
Được thích
40
Kính gửi anh chị,
Code kèm theo File hiện mới chỉ lấy Date là ngày đầu tiên. Giờ sửa code thế nào để nó lấy tất cả ngày (có cộng dồn nếu trùng ngày) ạ. Em cảm ơn ạ.
 

File đính kèm

Giải pháp
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:

Mã:
= Table.Group(#"Changed Type", {"Code"}, {{"Quantity", each List.Sum([Quantity]), type nullable number}, {"Date", each List.Min([Date]), type nullable date}})

ADO thì như sau:
Mã:
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 Sub
Cảm ơn anh,
Thiếu xót quá, không thấy chủ Topic ý kiến gì? Vậy cả code bài #2 cũng chưa chuẩn. Chỉ Group theo Mã sản phẩm.
Em có...
Kính gửi anh chị,
Code kèm theo File hiện mới chỉ lấy Date là ngày đầu tiên. Giờ sửa code thế nào để nó lấy tất cả ngày (có cộng dồn nếu trùng ngày) ạ. Em cảm ơn ạ.
Mã:
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
Không biết phải bạn đang muốn thế này không?
 
Upvote 0
Mã:
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
       [ICODE] sKey = ArrData(i, 1) & "|" & ArrData(i, 2)[/ICODE]
        If sKey <> "" Then
            If Not Dic.Exists(sKey) Then
                j = j + 1
                Dic.Add sKey, j
                Result(j, 1) = j
                Result(j, 2) = [ICODE]ArrData(i, 1)[/ICODE]
                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
Không biết phải bạn đang muốn thế này không?
Đúng là em cần thế này rồi ạ ! Em cảm ơn anh nhiều !
 
Upvote 0
Một giải pháp dùng Power Query, chỉ cần thao tác chuột, không đụng đến một chút VBA nào.
Click Power Query nhé
 

File đính kèm

Upvote 0
Máy không có Power Query thì làm thế nào bạn?
Từ phiên bản excel 2016 thì PQ là tool có sẵn.
Còn từ 2013 trở về trước thì phải cài addin
Mà giờ đã ra mắt đến O2021 rồi thì chắc cũng nên up tối thiểu lên 2016 dùng cho đủ tính năng.
 
Upvote 0
Từ phiên bản excel 2016 thì PQ là tool có sẵn.
Còn từ 2013 trở về trước thì phải cài addin
Mà giờ đã ra mắt đến O2021 rồi thì chắc cũng nên up tối thiểu lên 2016 dùng cho đủ tính năng.
--=0 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
 
Upvote 0
--=0 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
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.
 
Upvote 0
Upvote 0
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.
Có rồi bạn. Đây là từ tài liệu của bác ptm0412 và tôi đã Enable nó. Nhưng xong rồi cũng để vậy thôi chứ tôi chưa dùng tới bao giờ.
1631329684634.png
 
Upvote 0
Upvote 0
Bác có thể hướng dẫn giúp em từng bước thao tác PW để ra được kết quả như trong file của bác không
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.
2. File của bạn cũng giống File của chủ thớt? Vì mỗi bài sẽ có cách thao tác khác nhau, bạn nên mở hẳn một Topic khác hỏi, có khi ngoài PQ ra sẽ có nhiều giải pháp khác.
 
Upvote 0
Một giải pháp dùng Power Query, chỉ cần thao tác chuột, không đụng đến một chút VBA nào.
Click Power Query nhé
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:

Mã:
= Table.Group(#"Changed Type", {"Code"}, {{"Quantity", each List.Sum([Quantity]), type nullable number}, {"Date", each List.Min([Date]), type nullable date}})

ADO thì như sau:
Mã:
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 Sub
 
Upvote 0
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:

Mã:
= Table.Group(#"Changed Type", {"Code"}, {{"Quantity", each List.Sum([Quantity]), type nullable number}, {"Date", each List.Min([Date]), type nullable date}})

ADO thì như sau:
Mã:
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 Sub
Cảm ơn anh,
Thiếu xót quá, không thấy chủ Topic ý kiến gì? Vậy cả code bài #2 cũng chưa chuẩn. Chỉ Group theo Mã sản phẩm.
Em có sửa lại để File cả 3 giải pháp: Dictionary, PowerQuery, ADO.
Anh @Hai Lúa Miền Tây code thêm cho bạn trường số thứ tự nữa là đẹp ạ. Phần ADO em không biết code thế nào.
 

File đính kèm

Upvote 1
Giải pháp
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.
2. File của bạn cũng giống File của chủ thớt? Vì mỗi bài sẽ có cách thao tác khác nhau, bạn nên mở hẳn một Topic khác hỏi, có khi ngoài PQ ra sẽ có nhiều giải pháp khác.
em đang dùng office 365, bài của e cũng tương tự giống vậy, đồng thời em cũng đang tìm hiểu về PW
 
Upvote 0
Upvote 0
Cảm ơn anh,
Thiếu xót quá, không thấy chủ Topic ý kiến gì? Vậy cả code bài #2 cũng chưa chuẩn. Chỉ Group theo Mã sản phẩm.
Em có sửa lại để File cả 3 giải pháp: Dictionary, PowerQuery, ADO.
Anh @Hai Lúa Miền Tây code thêm cho bạn trường số thứ tự nữa là đẹp ạ. Phần ADO em không biết code thế nào.
Để 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ó.
 
Upvote 0
Để 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:
Mã:
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

Qua 3 cái code e có chút cảm nhận, dù với rất ít dữ liệu thôi nhưng: Dic cực mượt, ADO và PQ có chút chờ đợi, PQ thì khá hơn chỉ mất thời gian chạy lần đầu, từ lần sau nhanh hơn, còn ADO như là lần nào cũng phải tạo kết nối nên hơi chậm.
 
Upvote 0
Vậy em bổ sung thêm thế này:
Mã:
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

Qua 3 cái code e có chút cảm nhận, dù với rất ít dữ liệu thôi nhưng: Dic cực mượt, ADO và PQ có chút chờ đợi, PQ thì khá hơn chỉ mất thời gian chạy lần đầu, từ lần sau nhanh hơn, còn ADO như là lần nào cũng phải tạo kết nối nên hơi chậm.
Ở đây em thấy kết quả cột Date mới chỉ lấy một ngày đầu tiên. Nếu Lấy tất cả ngày và có cộng dồn nếu trùng ngày thì có làm được bằng ADO không ạ !
 
Upvote 0
Vậy em bổ sung thêm thế này:
Mã:
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

Qua 3 cái code e có chút cảm nhận, dù với rất ít dữ liệu thôi nhưng: Dic cực mượt, ADO và PQ có chút chờ đợi, PQ thì khá hơn chỉ mất thời gian chạy lần đầu, từ lần sau nhanh hơn, còn ADO như là lần nào cũng phải tạo kết nối nên hơi chậm.
Nên dựa vào số dòng trong Recordset rồi gán xuống luôn em. Về tốc độ thì nhanh chậm chút ít thời gian, nhiều khi phải cho mắt nghỉ ngơi, hoặc đi uống cà phê :D . Quen cái nào thì dùng cái ấy thôi em.
 
Upvote 0
Ở đây em thấy kết quả cột Date mới chỉ lấy một ngày đầu tiên. Nếu Lấy tất cả ngày và có cộng dồn nếu trùng ngày thì có làm được bằng ADO không ạ !
Code ADO bạn hỏi anh @Hai Lúa Miền Tây
Quan trọng là ở đây là bạn cộng dồn theo mấy tiêu chí (1) cộng dồn theo mã thôi? (2) hay cộng dần theo cả mã cả ngày? phải theo (2) thì mới thêm được cột theo từng ngày chứ bạn? như code bài #2.
 
Upvote 0
Ở đây em thấy kết quả cột Date mới chỉ lấy một ngày đầu tiên. Nếu Lấy tất cả ngày và có cộng dồn nếu trùng ngày thì có làm được bằng ADO không ạ !
Bỏ tính toán của cột Date, Group By cột này là được nhé.
Mã:
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], [Date], Sum(Quantity) From [ArrayList$] where [Code] Is Not Null Group By [Code],[Date]")
    End With
End Sub
 
Upvote 0
Bỏ tính toán của cột Date, Group By cột này là được nhé.
Mã:
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], [Date], Sum(Quantity) From [ArrayList$] where [Code] Is Not Null Group By [Code],[Date]")
    End With
End Sub

Bỏ tính toán của cột Date, Group By cột này là được nhé.
Mã:
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], [Date], Sum(Quantity) From [ArrayList$] where [Code] Is Not Null Group By [Code],[Date]")
    End With
End Sub
Code chạy đúng rồi ạ ! ADO đúng là thỏa đam mê vừa dùng SQL vừa dùng VBA. Hay anh ạ !
 
Upvote 0
Upvote 0
Vậy em bổ sung thêm thế này:
Mã:
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

Qua 3 cái code e có chút cảm nhận, dù với rất ít dữ liệu thôi nhưng: Dic cực mượt, ADO và PQ có chút chờ đợi, PQ thì khá hơn chỉ mất thời gian chạy lần đầu, từ lần sau nhanh hơn, còn ADO như là lần nào cũng phải tạo kết nối nên hơi chậm.
Gán trực tiếp Recordset ví dụ như sau nhe em.
Mã:
Sub Gop_HLMT()
    With CreateObject("ADODB.Recordset")
        .Open "Select [Code], [Date], Sum(Quantity) From [ArrayList$] where [Code] Is Not Null Group By [Code],[Date]", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0", 1
        Sheet1.Range("L2:O100").ClearContents
        Sheet1.Range("M2").CopyFromRecordset .DataSource
        Sheet1.Range("L2:L" & .RecordCount + 1) = [row(a:a)]
    End With
End Sub
 
Upvote 0
Gán trực tiếp Recordset ví dụ như sau nhe em.
Mã:
Sub Gop_HLMT()
    With CreateObject("ADODB.Recordset")
        .Open "Select [Code], [Date], Sum(Quantity) From [ArrayList$] where [Code] Is Not Null Group By [Code],[Date]", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0", 1
        Sheet1.Range("L2:O100").ClearContents
        Sheet1.Range("M2").CopyFromRecordset .DataSource
        Sheet1.Range("L2:L" & .RecordCount + 1) = [row(a:a)]
    End With
End Sub
Hi anh @Hai Lúa Miền Tây, đoạn code này:
Mã:
From [ArrayList$]
Nó sẽ tạo connection đến vùng đầu tiên của sheet ArrayList đúng không anh?
 
Upvote 0
Upvote 0
Trong sheet đó đang còn nhiều bảng mà anh nhỉ? e đang hiểu là nó chỉ connection đến vùng đầu tiên để tính toán.

View attachment 266062
Em tạo 1 sheet mới và chạy code sau để đổ dữ liệu vào sheet mới. Từ đó nghiệm ra nhé.

Mã:
Sub Gop_HLMT()
    With CreateObject("ADODB.Recordset")
        .Open "Select * From [ArrayList$] ", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0", 1
        Sheet2.Range("M2").CopyFromRecordset .DataSource
        Sheet2.Range("L2:L" & .RecordCount + 1) = [row(a:a)]
    End With
End Sub
 
Upvote 0
Em tạo 1 sheet mới và chạy code sau để đổ dữ liệu vào sheet mới. Từ đó nghiệm ra nhé.

Mã:
Sub Gop_HLMT()
    With CreateObject("ADODB.Recordset")
        .Open "Select * From [ArrayList$] ", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0", 1
        Sheet2.Range("L2:O100").ClearContents
        Sheet2.Range("M2").CopyFromRecordset .DataSource
        Sheet2.Range("L2:L" & .RecordCount + 1) = [row(a:a)]
    End With
End Sub
Em có tạo sheet mởi, xóa vùng đầu tiên đi, thì kết quả nó lấy ở vùng tiếp theo. (Đỏ là vùng kết quả)
Snag_e43d533.png
 
Upvote 0
Upvote 0
video này sai đúng không bạn? Mình chỉ cần sửa là group theo code và date là được.
uhm, bạn phần Groupby thì bạn add thêm trường Date vào thôi, còn đến giờ tôi cũng chưa biết là sai hay là đúng? Chưa thấy chủ thớt chốt lại kết quả như thế nào là đúng í đó.
 
Upvote 0

Bài viết mới nhất

Back
Top Bottom