Tổng hợp dữ liệu từ nhiều sheet vào 1 sheet TongHop (1 người xem)

[ku_ri]

Như tiêu đề, em có 1 file excel như file đính kèm, mục đích là em muốn đếm số dòng CÓ SỐ ở cột F của mỗi sheet (không đếm dòng có chữ) và tổng hợp theo tên của sheet để cho ra kết quả như sheet tổng hợp, em có khoảng 20 sheet, mỗi sheet có thể có đến 1000 dòng, mọi người giúp em với ạ, hoặc mọi người làm giúp em code để copy cột F ở sheet 1 -> cột A ở sheet TongHop, tương tự cột F ở quý 2 -> cột B ở sheet TongHop,.....rồi em tự count cũng được ạ, cảm ơn mọi người. Em có coi những bài tổng hợp sheet cũ nhưng không có cái nào áp dụng được như mục đích.

 

[befaint]

Chép vào một module (khác dữ liệu thật thì bạn tự sửa):

Function Dem(rng As Range) As Long
If rng.Columns.Count > 1 Then Exit Function
Dim cll As Range
For Each cll In rng
    If IsNumeric(cll.Value) Then Dem = Dem + 1
Next cll
End Function
'--------------
Sub ku_ri()
Dim sh As Worksheet, lr As Long, tmp() As Variant, r As Integer
ReDim tmp(1 To ThisWorkbook.Worksheets.Count - 1, 1 To 2)
For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> "TongHop" Then
        lr = sh.Range("F65000").End(xlUp).Row
        r = r + 1
        tmp(r, 1) = sh.Name
        tmp(r, 2) = Dem(sh.Range("F3:F" & lr))
    End If
Next sh
Sheets("TongHop").Range("B4:C500").ClearContents
Sheets("TongHop").Range("B4").Resize(UBound(tmp, 1), 2).Value = tmp
End Sub

 

[ku_ri]

Em đã ứng dụng vào file gốc, nó chạy rất tốt a ơi, tuy nhiên e gặp thêm một vấn đề là giữa những dữ liệu số ở cột F nó không liên tiếp, có khi có ô trống ở giữa, code ở trên sẽ đếm luôn ô trống đó, em muốn nó không đếm ô trống có được không ạ, chỉ đếm những ô số thôi. Em quên mất trường hợp này, anh chỉnh sửa lại code giúp em với chứ em mù VBA . Ví dụ như file đính kèm, e bỏ 2 dữ liệu ở quý 3 nó vẫn đếm ra 7 ở sheet TongHop, kết quả em cần là 5 thôi ạ. Cảm ơn anh nhiều

 

[befaint]

Em đã ứng dụng vào file gốc, nó chạy rất tốt a ơi, tuy nhiên e gặp thêm một vấn đề là giữa những dữ liệu số ở cột F nó không liên tiếp, có khi có ô trống ở giữa, code ở trên sẽ đếm luôn ô trống đó, em muốn nó không đếm ô trống có được không ạ, chỉ đếm những ô số thôi. Em quên mất trường hợp này, anh chỉnh sửa lại code giúp em với chứ em mù VBA . Ví dụ như file đính kèm, e bỏ 2 dữ liệu ở quý 3 nó vẫn đếm ra 7 ở sheet TongHop, kết quả em cần là 5 thôi ạ. Cảm ơn anh nhiều

Sửa dòng
If IsNumeric(cll.Value) Then Dem = Dem + 1
thành
If cll.Value <> "" And IsNumeric(cll.Value) Then Dem = Dem + 1

 

[ku_ri]

Sửa dòng
If IsNumeric(cll.Value) Then Dem = Dem + 1
thành
If cll.Value <> "" And IsNumeric(cll.Value) Then Dem = Dem + 1

Em đã thử và thành công, cảm ơn b nhiều nhé

 

[ku_ri]

Public Sub GPE()
Dim cn As Object, Ax As String, Bx As String
Dim rs As Object, Ws As Worksheet
If Application.Version < 12 Then
    Ax = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
    Bx = ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
Else
    Ax = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="
    Bx = ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
End If
Set cn = CreateObject("ADODB.Connection")
cn.Open (Ax & ThisWorkbook.FullName & Bx)
Application.ScreenUpdating = False
With Sheets("TongHop")
.Range("B4:C1000").ClearContents: .Range("B4").Value = "GPE"
For Each Ws In Worksheets
If Ws.Name <> "TongHop" Then
    Set rs = cn.Execute("Select '" & Ws.Name & "', count(f1) from[" & Ws.Name & "$F3:F] where Isnumeric(f1)")
    If Not rs.EOF Then
        .Range("B65000").End(3)(2).CopyFromRecordset rs
        rs.Close
    End If
End If
Next Ws
End With
cn.Close
Set cn = Nothing
Set rs = Nothing
Application.ScreenUpdating = True
End Sub

Code này cũng chạy oke lun b ơi, cảm ơn b nhiều