vuongthuytt
Thành viên mới

- Tham gia
- 28/6/11
- Bài viết
- 1
- Được thích
- 0
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!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.
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
Nếu tổng hợp mà đua tốc độ thì mình khoái nhất cái thư viện Dictionary.
Mấy cái vụ này em viết 1 lúc cả đống codeNếu dùng Consolidate thì sao? (đương nhiên là viết code chứ hổng phải làm bằng tay)![]()
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
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.Mấy cái vụ này em viết 1 lúc cả đống code
Thêm cái nữa nè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
Nếu chưa vừa ý em còn cách khác nữa cũng ConsolidatePHP: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