tổng hợp theo các sheet có điều kiện (1 người xem)

[thuhacoi]

khi áp dụng vào thực tế phát sinh tình huống này,cả nhà giúp em thêm điều kiện nữa với

 

[nhat chi mai]

khi áp dụng vào thực tế phát sinh tình huống này,cả nhà giúp em thêm điều kiện nữa với

bạn có hỏi thì hỏi cùng 1 topic thôi, cùng 1 bài mà. Tớ nghĩ câu hỏi này của bạn có thừa không nhỉ? bởi vì nhập dữ liệu trong excel cũng cần khoa học cho dễ thao tác trong bảng tính mà. giả sử bạn đảo lộn các stt A, B, C trong sheet1, sheet2 ấy... thì nếu có làm cũng bố trị lại với bt mà đã làm theo topic này http://www.giaiphapexcel.com/forum/showthread.php?73333-giúp-tính-tổng-theo-2-điều-kiện

 

[thuhacoi]

bạn có hỏi thì hỏi cùng 1 topic thôi, cùng 1 bài mà. Tớ nghĩ câu hỏi này của bạn có thừa không nhỉ? bởi vì nhập dữ liệu trong excel cũng cần khoa học cho dễ thao tác trong bảng tính mà. giả sử bạn đảo lộn các stt A, B, C trong sheet1, sheet2 ấy... thì nếu có làm cũng bố trị lại với bt mà đã làm theo topic này http://www.giaiphapexcel.com/forum/showthread.php?73333-gi%C3%BAp-t%C3%ADnh-t%E1%BB%95ng-theo-2-%C4%91i%E1%BB%81u-ki%E1%BB%87n

Cám ơn bạn trả lời, xong thực tế không phải chỉ phát sinh A. B.C mà có khoảng 70 mã và khoảng 100 sheet, do không muốn liệt kê tất cả mà chỉ khi nào cần dùng mã nào thì chọn mã đó, do đó mới như vậy.

 

[Hoàng Trọng Nghĩa]

Cám ơn bạn trả lời, xong thực tế không phải chỉ phát sinh A. B.C mà có khoảng 70 mã và khoảng 100 sheet, do không muốn liệt kê tất cả mà chỉ khi nào cần dùng mã nào thì chọn mã đó, do đó mới như vậy.

Bởi ngay từ đầu bạn nói sớm như vậy thì người ta sẽ hướng cho bạn cách giải quyết khác.

Cho tôi hỏi, những bảng của mỗi sheet là do bạn tự tạo hay cty bắt phải làm như vậy? Có thể làm khác được không? Chứ làm kiểu này thì sao hiệu quả quản lý được?

 

[thuhacoi]

Bởi ngay từ đầu bạn nói sớm như vậy thì người ta sẽ hướng cho bạn cách giải quyết khác.

Cho tôi hỏi, những bảng của mỗi sheet là do bạn tự tạo hay cty bắt phải làm như vậy? Có thể làm khác được không? Chứ làm kiểu này thì sao hiệu quả quản lý được?

Thực tế như vậy, nếu sắp xếp được thì lại làm theo lần 1 các bạn hướng dẫn, do đó mong bạn xem giúp mình với nhé

 

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

khi áp dụng vào thực tế phát sinh tình huống này,cả nhà giúp em thêm điều kiện nữa với

Làm cho bạn = ADO như sau:

Sub GopSheet_HLMT()
     Dim cn As Object, rst As Object, cat As Object, tbl As Object, str$, str1 As String
       Set cn = CreateObject("ADODB.Connection")
       Set cat = CreateObject("ADOX.Catalog")
       Set tbl = CreateObject("ADOX.Table")
       Set rst = CreateObject("ADODB.Recordset")
            With cn
                 .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                                     "Data Source=" & ThisWorkbook.FullName & _
                                     ";Extended Properties=""Excel 8.0;HDR=Yes;"";"
                 .Open
            End With
            cat.ActiveConnection = cn
            For Each tbl In cat.Tables
                If Right(Replace(tbl.Name, "'", ""), 1) = "$" And Left(tbl.Name, 6) <> "Ketqua" Then
                    str = str & " union all SELECT [Ngày thag],A,B,C from [" & Replace(Replace(tbl.Name, "$", ""), "'", "") & "$] "
                    str1 = Right(str, Len(str) - 10)
                End If
            Next
            
            With rst
                .ActiveConnection = cn
                .Open "select [Ngày thag],sum(A),sum(B),sum(C) from (" & str1 & ") group by [Ngày thag]"
           End With
           With Sheets("KetQua")
                .[A2:IV65000].ClearContents
                .[A2].CopyFromRecordset rst
           End With
      rst.Close: Set rst = Nothing
      cn.Close: Set cn = Nothing
      Set cat = Nothing: Set tbl = Nothing
      
  End Sub

 

[Ba Tê]

Thất nghiệp làm bằng VBA, xài 2 cái "Đíc" thử xem, tốc độ thì "hổng biết" à nghe!

Public Sub GPE()
Dim Rng1(), Rng2(), Arr(), DCot As Object, DDong As Object, I As Long, J As Long
Dim Rng(), Cot As Variant, Dong As Variant, Tem As Variant, WS As Worksheet
Set DCot = CreateObject("Scripting.Dictionary")
Set DDong = CreateObject("Scripting.Dictionary")
With Sheets("Ketqua")
    Rng2 = .Range(.[B5], .[IV5].End(xlToLeft)).Value
        For I = 1 To UBound(Rng2, 2)
            If Not DCot.Exists(Rng2(1, I)) Then DCot.Add Rng2(1, I), I
        Next I
    Rng1 = .Range([A6], .[A65000].End(xlUp)).Value
        For I = 1 To UBound(Rng1, 1)
            If Not DDong.Exists(Rng1(I, 1)) Then DDong.Add Rng1(I, 1), I
        Next I
End With
ReDim Arr(1 To UBound(Rng1, 1), 1 To UBound(Rng2, 2))
For Each WS In ThisWorkbook.Worksheets
    If WS.Name <> "Ketqua" Then
        Tem = WS.[IV5].End(xlToLeft).Column
        Rng = WS.Range(WS.[A5], WS.[A65000].End(xlUp)).Resize(, Tem).Value
        For I = 2 To UBound(Rng, 1)
            Dong = Rng(I, 1)
            If DDong.Exists(Dong) Then
                For J = 2 To UBound(Rng, 2)
                    Cot = Rng(1, J)
                    If DCot.Exists(Cot) Then
                        Arr(DDong.Item(Dong), DCot.Item(Cot)) = Arr(DDong.Item(Dong), DCot.Item(Cot)) + Rng(I, J)
                    End If
                Next J
            End If
        Next I
    End If
Next
Sheets("Ketqua").[B6].Resize(UBound(Rng1, 1), UBound(Rng2, 2)).Value = Arr
Set DCot = Nothing: Set DDong = Nothing
End Sub

 

[Hoàng Trọng Nghĩa]

Làm cho bạn = ADO như sau:

Sub GopSheet_HLMT()
     Dim cn As Object, rst As Object, cat As Object, tbl As Object, str$, str1 As String
       Set cn = CreateObject("ADODB.Connection")
       Set cat = CreateObject("ADOX.Catalog")
       Set tbl = CreateObject("ADOX.Table")
       Set rst = CreateObject("ADODB.Recordset")
            With cn
                 .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                                     "Data Source=" & ThisWorkbook.FullName & _
                                     ";Extended Properties=""Excel 8.0;HDR=Yes;"";"
                 .Open
            End With
            cat.ActiveConnection = cn
[COLOR=#0000ff][B]            For Each tbl In cat.Tables
                If Right(Replace(tbl.Name, "'", ""), 1) = "$" And Left(tbl.Name, 6) <> "Ketqua" Then
                    str = str & " union all SELECT [Ngày thag],A,B,C from [" & Replace(Replace(tbl.Name, "$", ""), "'", "") & "$] "
                    str1 = Right(str, Len(str) - 10)
                End If
            Next[/B][/COLOR]
            
            With rst
                .ActiveConnection = cn
                .Open "select [Ngày thag],sum(A),sum(B),sum(C) from (" & str1 & ") group by [Ngày thag]"
           End With
           With Sheets("KetQua")
                .[A2:IV65000].ClearContents
                .[A2].CopyFromRecordset rst
           End With
      rst.Close: Set rst = Nothing
      cn.Close: Set cn = Nothing
      Set cat = Nothing: Set tbl = Nothing
      
  End Sub

Thuật toán ADO về gộp dữ liệu các sheet của HLMT rất hay, nhưng anh xin góp ý một tí, chỗ này có thể là HLMT viết vội nên không để ý nè:

Chỗ màu xanh, thay vì như vậy thì chỉnh lại như sau:

    For Each tbl In cat.Tables
        If tbl.Name <> "Ketqua$" Then
            str = str & " UNION ALL SELECT [Ngày thag], A, B, C FROM [" & Replace(tbl.Name, "'", "") & "] "
        End If
    Next
    
    str1 = Right(str, Len(str) - 10)

Với sheet Ketqua là sheet mình chủ động và biết chắc tên của nó như thế nào nên ta dễ dàng biến chuyển nó, nên ta không cần phải thay thế dấu nháy và thêm vào $. Nếu sheet đó là Ket Qua thì ta chỉ cần đổi thành: If tbl.Name <> "'Ket Qua$'" (thêm 2 dấu nháy nữa thôi.

Cũng vậy với str, ta chỉ cần thay thế dấu nháy là được rồi, không cần phải Replace đến 2 lần.

Với str1 dù để trong vòng lặp cũng như ngoài vòng lặp thì kết quả vẫn như nhau, vì thế ta để ở ngoài sẽ đỡ nhiều công đoạn của mỗi lần lặp.

Không biết ý kiến của anh như vậy có đúng không nhỉ?

 

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

Thuật toán ADO về gộp dữ liệu các sheet của HLMT rất hay, nhưng anh xin góp ý một tí, chỗ này có thể là HLMT viết vội nên không để ý nè:

Chỗ màu xanh, thay vì như vậy thì chỉnh lại như sau:

    For Each tbl In cat.Tables
        If tbl.Name <> "Ketqua$" Then
            str = str & " UNION ALL SELECT [Ngày thag], A, B, C FROM [" & Replace(tbl.Name, "'", "") & "] "
        End If
    Next
    
    str1 = Right(str, Len(str) - 10)

Với sheet Ketqua là sheet mình chủ động và biết chắc tên của nó như thế nào nên ta dễ dàng biến chuyển nó, nên ta không cần phải thay thế dấu nháy và thêm vào $. Nếu sheet đó là Ket Qua thì ta chỉ cần đổi thành: If tbl.Name <> "'Ket Qua$'" (thêm 2 dấu nháy nữa thôi.

Cũng vậy với str, ta chỉ cần thay thế dấu nháy là được rồi, không cần phải Replace đến 2 lần.

Với str1 dù để trong vòng lặp cũng như ngoài vòng lặp thì kết quả vẫn như nhau, vì thế ta để ở ngoài sẽ đỡ nhiều công đoạn của mỗi lần lặp.

Không biết ý kiến của anh như vậy có đúng không nhỉ?

Anh thử duyệt qua các file có Name range và tên sheet có cách khoảng sẽ thấy sự khác biệt.

 

[Hoàng Trọng Nghĩa]

Anh thử duyệt qua các file có Name range và tên sheet có cách khoảng sẽ thấy sự khác biệt.

Thử rồi mới post lên mà!

Kiểm tra file nhé!

 

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

Thử rồi mới post lên mà!

Kiểm tra file nhé!

Vậy anh thử test lại theo file nhé.

 

[Hoàng Trọng Nghĩa]

Vậy anh thử test lại theo file nhé.

Khoan đã, CreateObject("ADOX.Table") nó lấy tên sheet và nó lấy tên theo Name luôn à?

 

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

Khoan đã, CreateObject("ADOX.Table") nó lấy tên sheet và nó lấy tên theo Name luôn à?

Chính xác như thế, các name , các vùng filter, PrinArea.... nó xem như là 1 bảng dữ liệu. Nên replace như thế là hợp lý.

 

[Hoàng Trọng Nghĩa]

Chính xác như thế, các name , các vùng filter, PrinArea.... nó xem như là 1 bảng dữ liệu. Nên replace như thế là hợp lý.

Trời ơi, như thế nếu dùng không khéo với For Each ... sẽ rất dễ phát sinh sai lầm phải không? Nếu sử dụng chúng phải đảm bảo cấu trúc đúng với ý đồ của ta.

À, nó có tính luôn cả name động hay không nhỉ? Chưa thử nên hỏi trước cho chắc ăn.

 

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

Trời ơi, như thế nếu dùng không khéo với For Each ... sẽ rất dễ phát sinh sai lầm phải không? Nếu sử dụng chúng phải đảm bảo cấu trúc đúng với ý đồ của ta.

À, nó có tính luôn cả name động hay không nhỉ? Chưa thử nên hỏi trước cho chắc ăn.

Vậy anh Test thử và đưa ra kết luận nhé.

 

[Hoàng Trọng Nghĩa]

Vậy anh Test thử và đưa ra kết luận nhé.

Test thử thì thấy: Name động, Table, Pivot Table nó không "ngó ngàng" gì tới, Name từ 2 ô trở đi thì nó "hỏi thăm" còn 1 ô thì nó lờ đi.