Nhờ tổng hợp nhiều Sheet vào 1 Sheet (không sử dụng công cụ Consolidate) (4 người xem)

[LinDan]

Em muốn tổng hợp doanh thu của từng mặt hàng trong các Sheet , nhưng không dùng các công cụ có sẵn như Consolidate, Pivot của Excel bởi mục đích của em tìm hiểu, học hỏi, luyện tập, đặc biệt là tư duy sử dụng một số hàm của Excel.

Bài toán trên có thể sử dụng công thức hoặc VBA (càng nhiều giải pháp làm càng tốt).

Xin trân trọng cảm ơn.
-----------
(trong file đính kèm em có 3 Sheet nhưng thực tế có thể nhiều hơn)

Kính mong mọi người trên diễn đàn giới thiệu dùm em một số bài toán từ đơn giản đến phức tạp để em luyện tập về hàm Indirect.

 

[Quang_Hải]

Em muốn tổng hợp doanh thu của từng mặt hàng trong các Sheet , nhưng không dùng các công cụ có sẵn như Consolidate, Pivot của Excel bởi mục đích của em tìm hiểu, học hỏi, luyện tập, đặc biệt là tư duy sử dụng một số hàm của Excel.

Bài toán trên có thể sử dụng công thức hoặc VBA (càng nhiều giải pháp làm càng tốt).

Xin trân trọng cảm ơn.
-----------
(trong file đính kèm em có 3 Sheet nhưng thực tế có thể nhiều hơn)

Kính mong mọi người trên diễn đàn giới thiệu dùm em một số bài toán từ đơn giản đến phức tạp để em luyện tập về hàm Indirect.

Bạn dùng code đơn giản này. Nhớ tạo thêm 1 sheet mới và đặt tên là TONGHOP

Sub tong_hop()
Dim dl(), kq(1 To 10000, 1 To 3), d As Object
Dim sh As Worksheet, i As Long, k As Long, x As Byte, dk As String
Set d = CreateObject("scripting.dictionary")
For Each sh In ThisWorkbook.Worksheets
   If sh.Name <> "TONGHOP" Then
      dl = sh.Range(sh.[a3], sh.[a65536].End(3)).Resize(, 2)
      For i = 1 To UBound(dl)
         dk = dl(i, 1)
         If dk <> "" Then
            If Not d.exists(dl(i, 1)) Then
               k = k + 1
               d.Add dk, k:    kq(k, 1) = k
               kq(k, 2) = dk:  kq(k, 3) = dl(i, 2)
            Else
               kq(d.Item(dk), 3) = kq(d.Item(dk), 3) + dl(i, 2)
            End If
         End If
      Next i
   End If
Next sh
Sheets("TONGHOP").[a3:c10000].ClearContents
Sheets("TONGHOP").[a3].Resize(k, 3) = kq
End Sub

 

[ndu96081631]

Em muốn tổng hợp doanh thu của từng mặt hàng trong các Sheet , nhưng không dùng các công cụ có sẵn như Consolidate, Pivot của Excel bởi mục đích của em tìm hiểu, học hỏi, luyện tập, đặc biệt là tư duy sử dụng một số hàm của Excel.

Yêu cầu không dùng Consolidate nhưng nếu tôi viết code dựa trên nền tảng Consolidate thì sao?
(Bởi viết code như vậy sẽ đơn giản hơn nhiều)

 

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

Em muốn tổng hợp doanh thu của từng mặt hàng trong các Sheet , nhưng không dùng các công cụ có sẵn như Consolidate, Pivot của Excel bởi mục đích của em tìm hiểu, học hỏi, luyện tập, đặc biệt là tư duy sử dụng một số hàm của Excel.

Bài toán trên có thể sử dụng công thức hoặc VBA (càng nhiều giải pháp làm càng tốt).

Xin trân trọng cảm ơn.
-----------
(trong file đính kèm em có 3 Sheet nhưng thực tế có thể nhiều hơn)

Kính mong mọi người trên diễn đàn giới thiệu dùm em một số bài toán từ đơn giản đến phức tạp để em luyện tập về hàm Indirect.

Tôi dùng ado để tổng hợp.

[GPECODE=sql]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=No;"";"
.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 F1, F2 from [" & Replace(Replace(tbl.Name, "$", ""), "'", "") & "$A3:B100] "
str1 = Right(str, Len(str) - 10)
End If
Next

With rst
.ActiveConnection = cn
.Open "select F1,sum(F2) from (" & str1 & ") group by F1"
End With
With Sheets("KetQua")
.[A2:B100].ClearContents
.[A2].CopyFromRecordset rst
End With
rst.Close: Set rst = Nothing
cn.Close: Set cn = Nothing
Set cat = Nothing: Set tbl = Nothing

End Sub

[/GPECODE]

 

[ndu96081631]

Còn đây là dùng Consolidate:

Function SheetExists(ByVal wksName As String) As Boolean
  On Error Resume Next
  SheetExists = Not Sheets(wksName) Is Nothing
End Function

Function CollectAllAddress(ByVal Table_Address As String)
  Dim Arr(), wks As Worksheet
  Dim n As Long
  For Each wks In Worksheets
    n = n + 1
    ReDim Preserve Arr(1 To n)
    Arr(n) = "'" & wks.Name & "'!" & Range(Table_Address).Address(, , 2)
  Next
  If n Then CollectAllAddress = Arr
End Function

Sub ConsolAllShs(ByVal Table_Address As String)
  Dim sWksDes As String, aAddress
  On Error Resume Next
  sWksDes = "SUMMARY"
  Application.DisplayAlerts = False
  If SheetExists(sWksDes) Then Worksheets(sWksDes).Delete
  Application.DisplayAlerts = True
  aAddress = CollectAllAddress(Table_Address)
  With Worksheets.Add(After:=Worksheets(Worksheets.Count))
    .Name = sWksDes
    With .Range(Table_Address)(1, 1)
      .Consolidate aAddress, 9, True, True
      .Value = Sheets(1).Range(Table_Address)(1, 1).Value
    End With
  End With
End Sub

Sub Main()
  Dim Table_Address As String
  Application.ScreenUpdating = False
  Table_Address = "A2:B1000"
  ConsolAllShs Table_Address
  Application.ScreenUpdating = True
End Sub

-------------------
Ghi chú:
- Hàm SheetExists để kiểm tra sự tồn tại của 1 sheet
- Hàm CollectAllAddress thu gom địa chỉ vùng (cần tổng hợp) tại tất cả các sheet và cho vào 1 mảng
- Sub ConsolAllShs thực thi việc tổng hợp dữ liệu thông qua địa chỉ cho sẵn
Chạy Sub Main sẽ có kết quả
-----------------
Tin rằng tốc độ chạy code sẽ rất nhanh (chắc chắn không thua kém Dictionary hay ADO...)
Thí nghiệm xem

 

[LinDan]

Yêu cầu không dùng Consolidate nhưng nếu tôi viết code dựa trên nền tảng Consolidate thì sao?
(Bởi viết code như vậy sẽ đơn giản hơn nhiều)

Thế thì tốt qua, cảm ơn thày đã giúp em có điều kiện học tập.

Ý của em là không muốn dùng thẳng các công cụ hỗ trợ nhanh của Excel để ra ngay kết quả. Em muốn học tập về thuật toán (cả công thức và VBA).

Em cảm thấy các kiến thức của mình khi kết hợp các công thức của Excel chưa tốt lắm. Em đang thử xem một bài toán cụ thể có thể giải tối đa nhiều cách, để từ đó mình biết ưu, nhược điểm của từng cách,
--> mục đích để biết cách sử dụng các hàm hợp lý hơn trong từng trường hợp, thuật toán nhanh hơn.

Em xin trân trọng nhờ mọi người giúp em nếu làm theo công thức sẽ có những hướng đi nào ah?

 

[ndu96081631]

Em xin trân trọng nhờ mọi người giúp em nếu làm theo công thức sẽ có những hướng đi nào ah?

Làm công thức không dễ ăn đâu. Riêng về phần tính tồng thì chẳng có vấn đề (dù là tính tổng 1 sheet hay nhiều sheet)... nhưng cái khó nhất là TRÍCH LỌC DUY NHẤT TỪ DỮ LIỆU Ở NHIỀU SHEET ---> Bạn nghĩ xem, nếu file có 20 sheet thì công thức trích lọc duy nhất này sẽ như thế nào?
Trích lọc duy nhất nội trong 1 sheet đã khiến cho file trở nên nặng nề, chứ còn 20 sheet thì có nước... đi chết đi cho rồi

 

[LinDan]

Làm công thức không dễ ăn đâu. Riêng về phần tính tồng thì chẳng có vấn đề (dù là tính tổng 1 sheet hay nhiều sheet)... nhưng cái khó nhất là TRÍCH LỌC DUY NHẤT TỪ DỮ LIỆU Ở NHIỀU SHEET ---> Bạn nghĩ xem, nếu file có 20 sheet thì công thức trích lọc duy nhất này sẽ như thế nào?
Trích lọc duy nhất nội trong 1 sheet đã khiến cho file trở nên nặng nề, chứ còn 20 sheet thì có nước... đi chết đi cho rồi

Em xin phép nhờ mọi người giúp em giải pháp tính tổng bằng công thức (bỏ qua trích lọc duy nhất--> cái này coi như đã làm xong bằng cách khác).

 

[ndu96081631]

Em xin phép nhờ mọi người giúp em giải pháp tính tổng bằng công thức (bỏ qua trích lọc duy nhất--> cái này coi như đã làm xong bằng cách khác).

- Đầu tiên tạo 1 sheet mới (tên tùy ý)
- Trong sheet mới này, gõ vào J2 trở xuống tên các sheet
- Đặt name cho khu vực tên sheet này:

wks =OFFSET($J$2,,,COUNTA($J$2:$J$1000),)

- Cũng trong sheet mới, từ A3 trở đi ta gõ tên mã hàng (không trùng)
- Tại B3, gõ công thức:

=SUMPRODUCT(SUMIF(INDIRECT("'"&wks&"'!A2:A100"),$A3,INDIRECT("'"&wks&"'!B2:B100")))

- Có thêm sheet mới, hãy gõ tên sheet vào cột J nhé

 

[huongthao92]

Bạn dùng code đơn giản này. Nhớ tạo thêm 1 sheet mới và đặt tên là TONGHOP

Sub tong_hop()
Dim dl(), kq(1 To 10000, 1 To 3), d As Object
Dim sh As Worksheet, i As Long, k As Long, x As Byte, dk As String
Set d = CreateObject("scripting.dictionary")
For Each sh In ThisWorkbook.Worksheets
   If sh.Name <> "TONGHOP" Then
      dl = sh.Range(sh.[a3], sh.[a65536].End(3)).Resize(, 2)
      For i = 1 To UBound(dl)
         dk = dl(i, 1)
         If dk <> "" Then
            If Not d.exists(dl(i, 1)) Then
               k = k + 1
               d.Add dk, k:    kq(k, 1) = k
               kq(k, 2) = dk:  kq(k, 3) = dl(i, 2)
            Else
               kq(d.Item(dk), 3) = kq(d.Item(dk), 3) + dl(i, 2)
            End If
         End If
      Next i
   End If
Next sh
Sheets("TONGHOP").[a3:c10000].ClearContents
Sheets("TONGHOP").[a3].Resize(k, 3) = kq
End Sub

Chú ơi, cháu thử dùng code của chú mà không được. Dữ liệu của cháu thì rất nhiều (tầm 92 sheet, mỗi sheet khoảng 40 dòng), là các sheet tính lương, các sheet có định dạng giống nhau. Chú có code nào có thể dùng được không cho cháu xin với. Cháu cảm ơn ạ