Tính tổng thỏa điều kiện từ nhiều Sheet về Sheet tổng hợp

vuongthuytt

Thành viên mới
Tham gia ngày
28 Tháng sáu 2011
Bài viết
1
Được thích
0
Điểm
0
Nhờ các Pro giúp dùm giải quyết bài toán này bằng "Công thức " và "viết VBA" nhé.

1. Tôi có 1 Sheet tổng hợp và các Sheet con (rất nhiều sheet)
2. Tôi muốn "Cộng" số lượng từ các Sheet con về Sheet tổng hợp.

TRÂN TRỌNG.
 

File đính kèm

vu_tuan_manh_linh

linhvtm84@gmail.com
Tham gia ngày
27 Tháng hai 2010
Bài viết
2,459
Được thích
1,725
Điểm
860
Nơi ở
Hà Nội
Nhờ các Pro giúp dùm giải quyết bài toán này bằng "Công thức " và "viết VBA" nhé.

1. Tôi có 1 Sheet tổng hợp và các Sheet con (rất nhiều sheet)
2. Tôi muốn "Cộng" số lượng từ các Sheet con về Sheet tổng hợp.

TRÂN TRỌNG.
Thử cách VBA này xem thế nào. Kết quả ok, chỉ e là với nhiều dòng và nhiều sheet thì code chậm!!! Bấm vào B1 để chạy code!
 

File đính kèm

Lần chỉnh sửa cuối:

nghiaphuc

Thành viên gạo cội
Thành viên danh dự
Tham gia ngày
25 Tháng chín 2009
Bài viết
5,722
Được thích
9,529
Điểm
910
Nơi ở
Ayun Pa - Gia Lai
Thêm một cách khác để tham khảo (hơi "ngố"):
[GPECODE=vb]Sub TinhTong()
Dim i As Long
Sheets("Tong Hop").Move Before:=Sheets(1)
For i = 2 To Sheets.Count
Sheets(1).[I65000].End(xlUp).Offset(1).Resize(9999, 2).Value = Sheets(i).[A2:B10000].Value
Next
i = Sheets(1).[A65000].End(xlUp).Row
With Sheets(1).Range("B2:B" & i)
.FormulaR1C1 = "=SUMIF(R2C9:R30000C9,RC[-1],R2C10:R30000C10)"
.Value = .Value
End With
Sheets(1).[I:J].Delete
End Sub[/GPECODE]
Ý tưởng: Kéo tuốt tuồn tuột về 1 vùng tạm trên sheet Tong Hop, sử dụng hàm SUMIF tính bình thường, sau đó ghi kết quả và xóa vùng tạm đi.
 

quanghai1969

Thành viên gạo cội
Tham gia ngày
21 Tháng hai 2009
Bài viết
5,638
Được thích
7,058
Điểm
860
Nơi ở
Thuận An, Bình Dương
Nếu tổng hợp mà đua tốc độ thì mình khoái nhất cái thư viện Dictionary.
PHP:
Sub tong_nhieu_sheet_vao_1_sheet()
Dim dl(), kq(1 To 65536, 1 To 3), d As Object
Dim sh As Worksheet, i As Long, k As Long, x As Long
Set d = CreateObject("scripting.dictionary")
For Each sh In ThisWorkbook.Worksheets
   If sh.Name <> "Tong Hop" Then
      dl = sh.Range(sh.[A2], sh.[b65536].End(3)).Value
      For i = 1 To UBound(dl)
         If dl(i, 1) <> "" Then
            If Not d.exists(dl(i, 1)) Then
               k = k + 1
               d.Add dl(i, 1), k
               kq(k, 1) = k
               kq(k, 2) = dl(i, 1)
               kq(k, 3) = dl(i, 2)
            Else
               x = d.Item(dl(i, 1))
               kq(x, 3) = kq(x, 3) + dl(i, 2)
            End If
         End If
      Next i
   End If
Next sh
Sheets("Tong Hop").[A2].Resize(k, 3) = kq
End Sub
 

quanghai1969

Thành viên gạo cội
Tham gia ngày
21 Tháng hai 2009
Bài viết
5,638
Được thích
7,058
Điểm
860
Nơi ở
Thuận An, Bình Dương
Nếu dùng Consolidate thì sao? (đương nhiên là viết code chứ hổng phải làm bằng tay) --=0
Mấy cái vụ này em viết 1 lúc cả đống code
PHP:
Sub consolidate1()
Dim vung_du_lieu
vung_du_lieu = Array("'sheet1'!R1C1:R65536C2", "'sheet2'!R1C1:R65536C2", "'sheet3'!R1C1:R65536C2")
With Sheets("Tong Hop")
   .[A2:B65536].ClearContents
   .[A1].consolidate vung_du_lieu, 9, 1, 1
End With
End Sub
Thêm cái nữa nè
PHP:
 Sub consolidate2()
  Dim sh, Arr(), i As Long
  ReDim Arr(Sheets.Count - 2)
  For Each sh In Worksheets
    If sh.Name <> "Tong hop" Then
      Arr(i) = "'" & sh.Name & "'!R1C1:R65536C2"
      i = i + 1
    End If
  Next
  Sheets("Tong hop").[A2:B65536].ClearContents
  Sheets("Tong hop").Range("A1").consolidate Arr, 9, 1, 1
End Sub
Nếu chưa vừa ý em còn cách khác nữa cũng Consolidate
 
Lần chỉnh sửa cuối:

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia ngày
5 Tháng sáu 2008
Bài viết
30,337
Được thích
52,771
Điểm
11,910
Nếu chưa vừa ý em còn cách khác nữa cũng Consolidate
Thông thường khi viết code thì tự tôi "chưa vừa ý" với chính tôi chứ không cần đến ai "chưa vừa ý" cả --=0
Vậy nếu tự mình cảm thấy chưa vừa ý thì cách khác xem
Ẹc... Ẹc...
 

namkpac

Thành viên thường trực
Tham gia ngày
25 Tháng mười một 2008
Bài viết
279
Được thích
9
Điểm
685
Mấy cái vụ này em viết 1 lúc cả đống code
PHP:
Sub consolidate1()
Dim vung_du_lieu
vung_du_lieu = Array("'sheet1'!R1C1:R65536C2", "'sheet2'!R1C1:R65536C2", "'sheet3'!R1C1:R65536C2")
With Sheets("Tong Hop")
   .[A2:B65536].ClearContents
   .[A1].consolidate vung_du_lieu, 9, 1, 1
End With
End Sub
Thêm cái nữa nè
PHP:
Sub consolidate2()
  Dim sh, Arr(), i As Long
  ReDim Arr(Sheets.Count - 2)
  For Each sh In Worksheets
    If sh.Name <> "Tong hop" Then
      Arr(i) = "'" & sh.Name & "'!R1C1:R65536C2"
      i = i + 1
    End If
  Next
  Sheets("Tong hop").[A2:B65536].ClearContents
  Sheets("Tong hop").Range("A1").consolidate Arr, 9, 1, 1
End Sub
Nếu chưa vừa ý em còn cách khác nữa cũng Consolidate
Anh quanghai1969, thầy ndu96081631 ơi!, giúp em sửa bài này giúp em với. em cũng muốn dung consolidate nhưng không biết làm gọn code khi chạy macro.
 
Top Bottom