Giúp mình code VBA lọc dữ liệu có điều kiện và tổng hợp

[nguyenkhoadng]

Nhờ các bạn giúp mình đoạn code VBA lọc dữ liệu có điều kiện, sau đó tổng hợp chúng lại. cụ thể như sau:
- ở sheet THONG-KE mình có 2 cấu kiện AA1 Và AA2, dữ liệu thống kê như trong file ví dụ đính kèm.
Mình muốn nhờ các bạn giúp mình đoạn vba tạo 1 sheet PHAN-TICH, trong đó có 2 bảng (BẢNG LỌC DỮ LIỆU và BẢNG TỔNG HỢP) cụ thể:
- ở bảng LỌC DỮ LIỆU sẽ lọc tất cả dữ liệu bên sheet THONG-KE dựa vào điều kiện là cột D và E. dữ liệu nào có cột D và E giống nhau thì cộng lại, còn lại khác nhau thì giữ nguyên. và vẫn giữ lại 2 cấu kiện AA1, AA2 như trong file ví dụ đính kèm.
- ở bảng TỔNG HỢP sẽ tổng hợp lại từ bảng LỌC DỮ LIỆU.

Nhờ các bạn giúp cho.
Cụ thể mình có ghi trong file đính kèm.
Mình cảm ơn!

 

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

Nhờ các bạn giúp mình đoạn code VBA lọc dữ liệu có điều kiện, sau đó tổng hợp chúng lại. cụ thể như sau:
- ở sheet THONG-KE mình có 2 cấu kiện AA1 Và AA2, dữ liệu thống kê như trong file ví dụ đính kèm.
Mình muốn nhờ các bạn giúp mình đoạn vba tạo 1 sheet PHAN-TICH, trong đó có 2 bảng (BẢNG LỌC DỮ LIỆU và BẢNG TỔNG HỢP) cụ thể:
- ở bảng LỌC DỮ LIỆU sẽ lọc tất cả dữ liệu bên sheet THONG-KE dựa vào điều kiện là cột D và E. dữ liệu nào có cột D và E giống nhau thì cộng lại, còn lại khác nhau thì giữ nguyên. và vẫn giữ lại 2 cấu kiện AA1, AA2 như trong file ví dụ đính kèm.
- ở bảng TỔNG HỢP sẽ tổng hợp lại từ bảng LỌC DỮ LIỆU.

Nhờ các bạn giúp cho.
Cụ thể mình có ghi trong file đính kèm.
Mình cảm ơn!

Nếu bạn muốn sắp xếp dữ liệu lại như file đính kèm của mình thì mình sẽ có cách giúp bạn.

 

[nguyenkhoadng]

Nếu bạn muốn sắp xếp dữ liệu lại như file đính kèm của mình thì mình sẽ có cách giúp bạn.

vậy nhờ bạn Hai Lúa Miền Tây giúp mình theo file mình đính kèm được không vậy?
mình cảm ơn trước!

 

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

vậy nhờ bạn Hai Lúa Miền Tây giúp mình theo file mình đính kèm được không vậy?
mình cảm ơn trước!

Bạn dùng code sau nhé:

[GPECODE=sql]Sub LocTong_HLMT()
Dim adoConn As Object, adoRS As Object
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
.Open
End With
With adoRS
.ActiveConnection = adoConn
.Open "select f1,'',f4,f5,sum(f16),sum(f17),sum(f11) " _
& "from [THONG-KE$A5:R100] " _
& "group by f1,f4,f5 " _
& "having f1 is not null"
End With
With Sheet2
.[A5:G100].ClearContents
.[A5].CopyFromRecordset adoRS
End With
adoRS.Close
With adoRS
.ActiveConnection = adoConn
.Open "select f4,f5,sum(f16),sum(f17),sum(f11) " _
& "from [THONG-KE$A5:R100] " _
& "group by f4,f5 " _
& "having f4 is not null " _
& "order by right(f5,1),f5"
End With
With Sheet2
.[J5:N100].ClearContents
.[J5].CopyFromRecordset adoRS
End With
adoRS.Close
Set adoRS = Nothing
adoConn.Close: Set adoConn = Nothing

End Sub
[/GPECODE]

 

[nguyenkhoadng]

Cảm ơn bạn!
Mình muốn lúc ban đầu chưa có sheet PHAN-TICH, tạo xong BẢNG THỐNG KÊ thì ta tiến hành chạy macro sẽ tự tạo ra sheet PHAN-TICH và tính toán như code của bạn. kết hợp với kẻ và định dạng 2 bảng LỌC DỮ LIỆU và TỔNG HỢP.
và mình có thay đổi chút ở bảng TỔNG HỢP.
Nhờ bạn Hai Lúa Miền Tây xem giúp mình với.
Mình cảm ơn!

 

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

Cảm ơn bạn!
Mình muốn lúc ban đầu chưa có sheet PHAN-TICH, tạo xong BẢNG THỐNG KÊ thì ta tiến hành chạy macro sẽ tự tạo ra sheet PHAN-TICH và tính toán như code của bạn. kết hợp với kẻ và định dạng 2 bảng LỌC DỮ LIỆU và TỔNG HỢP.
và mình có thay đổi chút ở bảng TỔNG HỢP như file mình đính kèm.
Nhờ bạn Hai Lúa Miền Tây xem giúp mình với.
Mình cảm ơn!

Làm cho bạn phần chuyển dữ liệu, còn phần định dạng bạn tự làm nhé.
(Lưu ý là có điều chỉnh tiêu đề cột cho hợp lý)

[GPECODE=sql]Sub LocTong_HLMT()
On Error Resume Next
Dim adoConn As Object, adoRS As Object, fld, i As Integer, eR As Integer
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
Application.DisplayAlerts = False
Sheets("PHAN-TICH").Delete
Sheets.Add
ActiveSheet.Name = "PHAN-TICH"
Application.DisplayAlerts = True
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
.Open
End With
With adoRS
.ActiveConnection = adoConn
.Open "select CK,'' as STT,QCT,SP,sum(CD) as [Tong CD],sum(TL) as [Tong TL],sum(DTS) as [Tong DTS] " _
& "from [THONG-KE$A4:R100] " _
& "group by CK,QCT,SP " _
& "having CK is not null"
End With
With Sheets("PHAN-TICH")
For Each fld In adoRS.Fields
i = i + 1
.Cells(4, i) = fld.Name
Next
.[A5].CopyFromRecordset adoRS
End With
adoRS.Close
With adoRS
.ActiveConnection = adoConn
.Open "select QCT,SP,sum(CD) as [Tong CD],sum(TL) as [Tong TL] " _
& "from [THONG-KE$A4:R100] " _
& "group by QCT,SP " _
& "having QCT is not null " _
& "order by right(SP,1),QCT"
End With
i = 0
With Sheets("PHAN-TICH")
For Each fld In adoRS.Fields
i = i + 1
.Cells(4, i + 9) = fld.Name
Next
.[J5].CopyFromRecordset adoRS
End With
adoRS.Close
With adoRS
.ActiveConnection = adoConn
.Open "select sum(DTS) as [Tong DTS] " _
& "from [THONG-KE$A4:R100]"
End With
With Sheets("PHAN-TICH")
eR = .Range("J65000").End(xlUp).Row + 1
.Range("K" & eR) = "Tong Cong"
.Range("K" & eR + 1) = "Tong DTS"
.Range("M" & eR).FormulaR1C1 = "=SUM(R[-" & eR - 5 & "]C:R[-1]C)"
.Range("L" & eR).FormulaR1C1 = "=SUM(R[-" & eR - 5 & "]C:R[-1]C)"
.Range("L" & eR + 1).CopyFromRecordset adoRS
.Cells.EntireColumn.AutoFit
End With
adoRS.Close: Set adoRS = Nothing
adoConn.Close: Set adoConn = Nothing

End Sub

[/GPECODE]

 

[nguyenkhoadng]

phần định dạng mình sẽ tự mày mò.
Mình cảm ơn nhiều!

 

[quocphuoc88]

Em có 1 câu hỏi ngoài lề xíu : e đang nguyên cứu mảng, nhưng toàn để ý thấy là thầy Hai Lúa Miền Tây viết bằng ADO( Thầy Nu toàn dùng mảng ) , vậy cho e hỏi là giữa 2 thằng này thì ADO và mảng thì thằng nào cho tốc độ ngon hơn ạ, và học ADO có khó không ?( vì e nhìn vào code nó như 1 cái rừng - e có đọc ADO căn bản của Thầy Lê Văn Duyệt mà nó khó hiểu và nản nản sao sao ah )

 

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

Em có 1 câu hỏi ngoài lề xíu : e đang nguyên cứu mảng, nhưng toàn để ý thấy là thầy Hai Lúa Miền Tây viết bằng ADO( Thầy Nu toàn dùng mảng ) , vậy cho e hỏi là giữa 2 thằng này thì ADO và mảng thì thằng nào cho tốc độ ngon hơn ạ, và học ADO có khó không ?( vì e nhìn vào code nó như 1 cái rừng - e có đọc ADO căn bản của Thầy Lê Văn Duyệt mà nó khó hiểu và nản nản sao sao ah )

Cũng còn tùy vào tình huống mỗi loại đều có thế mạnh riêng, ado kết hợp với arr sẽ cho ra kết quả tuyệt vời. Học ado không khó, nó còn dể hơn vba, nhưng nó không linh hoạt bằng vba. NẾu bạn biết kết hợp giữa vba và ado thì bạn sẽ giải quyết được nhiều việc lắm đó.
Bạn xem bài Bài tập về ADO căn bản. để hiểu thêm về ado nhé.

 

[nguyenkhoadng]

Làm cho bạn phần chuyển dữ liệu, còn phần định dạng bạn tự làm nhé.
(Lưu ý là có điều chỉnh tiêu đề cột cho hợp lý)

Nhờ bạn Hai Lúa Miền Tây xem giúp
Mình cảm ơn!

 

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

Nhờ bạn Hai Lúa Miền Tây xem giúp, tất cả mình có viết trong file đính kèm.
Mình cảm ơn!

Bạn chỉnh lại code như sau, riêng phần định dạng bạn tự làm nhé.

[GPECODE=sql]Sub ModTongHopThepHinh()
On Error Resume Next
Dim adoConn As Object, adoRS As Object, fld, i As Integer, eR As Integer
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
.Open
End With
With adoRS
.ActiveConnection = adoConn
.Open "select CK,CLT,QCT,sum(CD) as [TCD],sum(TL) as [TTL],sum(DTS) as [TDTS] " _
& "from [" & Sheet4.Name & "$A10:R500] " _
& "group by CK,CLT,QCT " _
& "having CK is not null"
End With
With Sheet4
.Range("U11:AF500").ClearContents
For Each fld In adoRS.Fields
i = i + 1
.Cells(10, i + 20) = fld.Name
Next
.[U11].CopyFromRecordset adoRS
End With
adoRS.Close
With adoRS
.ActiveConnection = adoConn
.Open "select '' as STT,CLT,QCT,sum(CD) as [TCD],sum(TL) as [TTL] " _
& "from [" & Sheet4.Name & "$A10:R500] " _
& "group by CLT,QCT " _
& "having CLT is not null " _
& "order by right(QCT,1),CLT"
End With
i = 0
With Sheet4
For Each fld In adoRS.Fields
i = i + 1
.Cells(10, i + 27) = fld.Name
Next
.[AB11].CopyFromRecordset adoRS
End With
adoRS.Close
With adoRS
.ActiveConnection = adoConn
.Open "select sum(DTS) as [TDTS] " _
& "from [" & Sheet4.Name & "$A10:R500]"
End With
With Sheet4
eR = .Range("AC65000").End(xlUp).Row + 1
.Range("AC" & eR) = "T" & ChrW(7892) & "NG C" & ChrW(7896) & "NG"
.Range("AC" & eR + 1) = "T" & ChrW(7892) & "NG DI" & ChrW(7878) & "N TÍCH S" & ChrW(416) & "N"
.Range("AE" & eR).FormulaR1C1 = "=SUM(R[-" & eR - 10 & "]C:R[-1]C)"
.Range("AF" & eR).FormulaR1C1 = "=SUM(R[-" & eR - 10 & "]C:R[-1]C)"
.Range("AE" & eR + 1).CopyFromRecordset adoRS
.Cells.EntireColumn.AutoFit
.Range("AB11:AB" & eR - 1).FormulaR1C1 = "=ROW()-10"
End With
adoRS.Close: Set adoRS = Nothing
adoConn.Close: Set adoConn = Nothing

End Sub
[/GPECODE]

P/S: Mai mốt đừng gọi đích danh mình để nhờ giúp nhé vì trên GPE có rất nhiều cao thủ, rủi mình không giúp được người khác biết được sẽ không giúp bạn đâu nhé.

 

[nguyenkhoadng]

Mình sẽ rút kinh nghiệm.
Cảm ơn bạn đã giúp và góp ý!
CHúc vui!

                & "from ["& Sheet4.Name& "$A10:R500]"

Mình muốn code chạy trên sheet hiện hành thì thay đổi đoạn code trên như thế nào vậy bạn?

 

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

Mình sẽ rút kinh nghiệm.
Cảm ơn bạn đã giúp và góp ý!
CHúc vui!

                & "from ["& Sheet4.Name& "$A10:R500]"

Mình muốn code chạy trên sheet hiện hành thì thay đổi đoạn code trên như thế nào vậy bạn?

Bạn chỉnh lại thành:

& "from [" & [B][COLOR=#ff0000]ActiveSheet.Name[/COLOR][/B] & "$A10:R500] " _

 

[nguyenkhoadng]

Bạn chỉnh lại code như sau, riêng phần định dạng bạn tự làm nhé.

Cho mình hỏi với đoạn code này khi mình chuyển file thống kê của mình thành add-ins để dùng thì đoạn code ko phân tích được.
Có phải muốn chuyển sang add-ins thì cần thêm bớt gì ko vậy?
nhờ các bạn giúp.
Mình cảm ơn!

 

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

Cho mình hỏi với đoạn code này khi mình chuyển file thống kê của mình thành add-ins để dùng thì đoạn code ko phân tích được.
Có phải muốn chuyển sang add-ins thì cần thêm bớt gì ko vậy?
nhờ các bạn giúp.
Mình cảm ơn!

Bạn thử code sau, xin lỗi vì chưa test thử.

[GPECODE=sql]Sub ModTongHopThepHinh()
On Error Resume Next
Dim adoConn As Object, adoRS As Object, fld, i As Integer, eR As Integer
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ActiveWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
.Open
End With
With adoRS
.ActiveConnection = adoConn
.Open "select CK,CLT,QCT,sum(CD) as [TCD],sum(TL) as [TTL],sum(DTS) as [TDTS] " _
& "from [" & ActiveSheet.Name & "$A10:R500] " _
& "group by CK,CLT,QCT " _
& "having CK is not null"
End With
With ActiveSheet
.Range("U11:AF500").ClearContents
For Each fld In adoRS.Fields
i = i + 1
.Cells(10, i + 20) = fld.Name
Next
.[U11].CopyFromRecordset adoRS
End With
adoRS.Close
With adoRS
.ActiveConnection = adoConn
.Open "select '' as STT,CLT,QCT,sum(CD) as [TCD],sum(TL) as [TTL] " _
& "from [" & ActiveSheet.Name & "$A10:R500] " _
& "group by CLT,QCT " _
& "having CLT is not null " _
& "order by right(QCT,1),CLT"
End With
i = 0
With ActiveSheet
For Each fld In adoRS.Fields
i = i + 1
.Cells(10, i + 27) = fld.Name
Next
.[AB11].CopyFromRecordset adoRS
End With
adoRS.Close
With adoRS
.ActiveConnection = adoConn
.Open "select sum(DTS) as [TDTS] " _
& "from [" & ActiveSheet.Name & "$A10:R500]"
End With
With ActiveSheet
eR = .Range("AC65000").End(xlUp).Row + 1
.Range("AC" & eR) = "T" & ChrW(7892) & "NG C" & ChrW(7896) & "NG"
.Range("AC" & eR + 1) = "T" & ChrW(7892) & "NG DI" & ChrW(7878) & "N TÍCH S" & ChrW(416) & "N"
.Range("AE" & eR).FormulaR1C1 = "=SUM(R[-" & eR - 10 & "]C:R[-1]C)"
.Range("AF" & eR).FormulaR1C1 = "=SUM(R[-" & eR - 10 & "]C:R[-1]C)"
.Range("AE" & eR + 1).CopyFromRecordset adoRS
.Cells.EntireColumn.AutoFit
.Range("AB11:AB" & eR - 1).FormulaR1C1 = "=ROW()-10"
End With
adoRS.Close: Set adoRS = Nothing
adoConn.Close: Set adoConn = Nothing

End Sub



[/GPECODE]

 

[nguyenkhoadng]

Cả 2 đoạn code trước và sau đều sử dụng tốt ở file excel. còn khi mình chuyển thành add-ins thì sử dụng bị lỗi.

 

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

Cả 2 đoạn code trước và sau đều sử dụng tốt ở file excel. còn khi mình chuyển thành add-ins thì sử dụng bị lỗi.

mình gửi file đính kèm.
ở add-ins thì chạy code tạo 1 bảng thống kê mới rồi sau đó chạy code tong hop.

Bạn bỏ dòng On Error Resume Next đi rồi test coi báo lỗi chổ nào nhé.

 

[nguyenkhoadng]

Bạn bỏ dòng On Error Resume Next đi rồi test coi báo lỗi chổ nào nhé.

báo lỗi như hình bạn ah:

 

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

báo lỗi như hình bạn ah:

Tôi test trên máy tôi chẳng có lỗi gì hết, hình bạn gửi nhỏ xíu tôi chẳng thấy gì.

 

[nguyenkhoadng]

Tôi test trên máy tôi chẳng có lỗi gì hết, hình bạn gửi nhỏ xíu tôi chẳng thấy gì.

Bạn sử dụng cái add-ins để test hay cái file excel?
Mình dùng sử dụng file excel thì chạy tốt còn với cái add-ins thì báo lỗi như trong hình trên.
Mình gửi lại hình bạn xem: