Các bạn giúp tôi viết code như sau:
Tôi có Sheet NhapBan, từ sheet này tôi muốn cộng dồn số lượng theo ngày và theo mã hàng hóa (Mã hàng hóa có thể nhiều hơn, đây chỉ là file demo)
Tôi muốn kết quả chạy code như ở sheet KQ
Cảm ơn các bạn!
Các bạn giúp tôi viết code như sau:
Tôi có Sheet NhapBan, từ sheet này tôi muốn cộng dồn số lượng theo ngày và theo mã hàng hóa (Mã hàng hóa có thể nhiều hơn, đây chỉ là file demo)
Tôi muốn kết quả chạy code như ở sheet KQ
Cảm ơn các bạn!
Sub Tonghop()
Dim Dic As Object, Tem As String
Dim sArr(), dArr(1 To 65535, 1 To 3)
Dim i As Long, j As Long, K As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("NhapBan")
sArr = .Range("G18", .Range("G65535").End(3)).Resize(, 15).Value
For i = 1 To UBound(sArr)
For j = 13 To 15
If sArr(i, j) <> Empty Then
Tem = sArr(i, 1) & "#" & .Cells(17, j + 6)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = sArr(i, 1)
dArr(K, 2) = .Cells(17, j + 6)
dArr(K, 3) = sArr(i, j)
Else
dArr(Dic.Item(Tem), 3) = dArr(Dic.Item(Tem), 3) + sArr(i, j)
End If
End If
Next j
Next i
End With
With Sheets("KQ")
With .Range("A5:C65535")
.ClearContents
.Borders.LineStyle = xlNone
End With
.Range("A5").Resize(K, 3) = dArr
With .Range("A5").Resize(K, 3)
.Borders.LineStyle = xlContinuous
.Borders(xlInsideHorizontal).Weight = xlHairline
End With
End With
End Sub
còn nhiều mã hàng nên cột cuối sẽ lớn hơn cột U, các khai báo
Mã:
dArr(1 To 65535, 1 To 3)
sArr = .Range("G18", .Range("G65535").End(3)).Resize(, 15).Value
sẽ phá sản
vừa dùng mảng vừa dùng cells rất phức tạp và làm chậm code
mình nghĩ bạn nên dùng 2 mãng dữ liệu: mảng 1 chứa cột ngày, mãng 2 chứa các cột mã hàng gồm dòng đầu là mã hàng các dòng dưới là số lượng, lúc đó dể viết hơn, dĩ nhiên phải dùng End để xác định cột cuối
còn nhiều mã hàng nên cột cuối sẽ lớn hơn cột U, các khai báo
Mã:
dArr(1 To 65535, 1 To 3)
sArr = .Range("G18", .Range("G65535").End(3)).Resize(, 15).Value
sẽ phá sản
vừa dùng mảng vừa dùng cells rất phức tạp và làm chậm code
mình nghĩ bạn nên dùng 2 mãng dữ liệu: mảng 1 chứa cột ngày, mãng 2 chứa các cột mã hàng gồm dòng đầu là mã hàng các dòng dưới là số lượng, lúc đó dể viết hơn, dĩ nhiên phải dùng End để xác định cột cuối
Dựa vào góp ý của anh và thầy Ba tê.Em thử sưa như thế này có được không anh:
Mã:
Sub Tonghop()
Dim Dic As Object, Tem As String
Dim sArr(), tArr(), dArr(1 To 65535, 1 To 3)
Dim i As Long, j As Long, K As Long, C As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("NhapBan")
C = .Range("IV17").End(xlToLeft).Column - 6
tArr = .Range("S17", .Range("IV17").End(xlToLeft)).Value
sArr = .Range("G18", .Range("G65535").End(3)).Resize(, C).Value
For i = 1 To UBound(sArr)
For j = 1 To UBound(tArr, 2)
If sArr(i, j + 12) <> Empty Then
Tem = sArr(i, 1) & "#" & tArr(1, j)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = sArr(i, 1)
dArr(K, 2) = tArr(1, j)
dArr(K, 3) = sArr(i, j + 12)
Else
dArr(Dic.Item(Tem), 3) = dArr(Dic.Item(Tem), 3) + sArr(i, j + 12)
End If
End If
Next j
Next i
End With
With Sheets("KQ")
With .Range("A5:C65535")
.ClearContents
.Borders.LineStyle = xlNone
End With
.Range("A5").Resize(K, 3) = dArr
With .Range("A5").Resize(K, 3)
.Borders.LineStyle = xlContinuous
.Borders(xlInsideHorizontal).Weight = xlHairline
End With
End With
End Sub
mảng dữ liệu chỉ lấy vùng cần thiết, không nên lấy tới 15 cột mà chỉ sử dụng 4 cột cách khoảng nhau, làm tốn bộ nhớ và phải đếm số cột để lấy dữ liệu ra xử lý
theo mình sẽ tạo các mảng như sau
Mã:
Sub Tonghop()
Dim Dic As Object, Tem As String
Dim sArr(), tArr(), dArr(1 To 65535, 1 To 3)
Dim i As Long, j As Long, K As Long, C As Long, LastR As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("NhapBan")
[COLOR=#ff0000]LastR[/COLOR] = .Range("G18").End(xlDown).Row 'dòng cuoi
[COLOR=#ff0000]C[/COLOR] = .Range("IV17").End(xlToLeft).Column [COLOR=#ff0000]- 18[/COLOR] 'só cot ma hàng
[COLOR=#ff0000]tArr[/COLOR] = .Range("G17:G" & [COLOR=#ff0000]LastR[/COLOR]).Value 'Array ngày tháng
[COLOR=#ff0000]sArr[/COLOR] = .Range("S17:S" & [COLOR=#ff0000]LastR).Resize(, C)[/COLOR].Value 'Array ma hàng
For i = [COLOR=#FF0000]2[/COLOR] To UBound(tArr)
For j = 1 To [COLOR=#ff0000]UBound(sArr, 2)[/COLOR]
If sArr(i, j) <> Empty Then
Tem = tArr(i, 1) & "#" & sArr([COLOR=#ff0000]1[/COLOR], j)
...
dArr(K, 3) = sArr(i, j)
With Sheets("NhapBan")
C = .Range("IV17").End(xlToLeft).Column - 6
sArr = .Range("[COLOR=#ff0000]G17[/COLOR]", .Range("G65535").End(3)).Resize(, C).Value
For i = [COLOR=#ff0000]2[/COLOR] To UBound(sArr)
For j = [COLOR=#ff0000]13[/COLOR] To UBound(sArr, 2)
If sArr(i, j) <> Empty Then
Tem = sArr(i, 1) & "#" & sArr([COLOR=#ff0000]1[/COLOR], j)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = sArr(i, 1)
dArr(K, 2) = sArr(1, j)
dArr(K, 3) = sArr(i, j)
Else
dArr(Dic.Item(Tem), 3) = dArr(Dic.Item(Tem), 3) + sArr(i, j)
End If
End If
Next j
Next i
End With
With Sheets("NhapBan")
C = .Range("IV17").End(xlToLeft).Column - 6
sArr = .Range("[COLOR=#ff0000]G17[/COLOR]", .Range("G65535").End(3)).Resize(, C).Value
For i = [COLOR=#ff0000]2[/COLOR] To UBound(sArr)
For j = [COLOR=#ff0000]13[/COLOR] To UBound(sArr, 2)
If sArr(i, j) <> Empty Then
Tem = sArr(i, 1) & "#" & sArr([COLOR=#ff0000]1[/COLOR], j)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = sArr(i, 1)
dArr(K, 2) = sArr(1, j)
dArr(K, 3) = sArr(i, j)
Else
dArr(Dic.Item(Tem), 3) = dArr(Dic.Item(Tem), 3) + sArr(i, j)
End If
End If
Next j
Next i
End With
Các bạn giúp tôi viết code như sau:
Tôi có Sheet NhapBan, từ sheet này tôi muốn cộng dồn số lượng theo ngày và theo mã hàng hóa (Mã hàng hóa có thể nhiều hơn, đây chỉ là file demo)
Tôi muốn kết quả chạy code như ở sheet KQ
Cảm ơn các bạn!
Em biết dùng PivotTable sẽ nhanh, nhưng vì kết quả của em sẽ sử dụng tiếp để lập báo cáo khác, vì nếu sử dụng PivotTable thì fải xử lý nữa ( chẳng hạn fải bỏ bớt 1 số râu ria)
Cho em hỏi thêm, nếu em muốn sheet KQ như sau thì sửa code như thế nào?
Sub TongHop_1()Dim Dic As Object, Tem As String
Dim C
Dim sArr(), dArr(1 To 65535, 1 To 3)
Dim i As Long, j As Long, K As Long
Set Dic = CreateObject("Scripting.Dictionary")
'**************
With Sheets("NhapBan")
C = .Range("IV17").End(xlToLeft).Column - 6
sArr = .Range("G17", .Range("G65535").End(3)).Resize(, C).Value
For i = 2 To UBound(sArr)
For j = 13 To UBound(sArr, 2)
If sArr(i, j) <> Empty Then
Tem = sArr(i, 1) & "#" & sArr(1, j)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = sArr(i, 1)
dArr(K, 2) = sArr(1, j)
dArr(K, 3) = sArr(i, j)
Else
dArr(Dic.Item(Tem), 3) = dArr(Dic.Item(Tem), 3) + sArr(i, j)
End If
End If
Next j
Next i
End With
'***********
With Sheets("KQ")
With .Range("A5:C65535")
.ClearContents
.Borders.LineStyle = xlNone
End With
Em biết dùng PivotTable sẽ nhanh, nhưng vì kết quả của em sẽ sử dụng tiếp để lập báo cáo khác, vì nếu sử dụng PivotTable thì fải xử lý nữa ( chẳng hạn fải bỏ bớt 1 số râu ria)
Em có thử làm, nhưng hay bị dính chữ "Total" ở các dòng nên fải xóa nó đi
Mặc khác, theo cách làm của thầy, thì ta fải tiếp tục xử lý copy ngày xuống dưới (Ví dụ Copy ngày 01/01/17 ở mã hàng H001, để paste ở mã hàng H002, H003...
Em có thử làm, nhưng hay bị dính chữ "Total" ở các dòng nên fải xóa nó đi
Mặc khác, theo cách làm của thầy, thì ta fải tiếp tục xử lý copy ngày xuống dưới (Ví dụ Copy ngày 01/01/17 ở mã hàng H001, để paste ở mã hàng H002, H003...
Mấy món đó người ta thao tác trong vòng.. 1 nốt nhạc chứ khó khăn gì đâu. Tất cả chỉ là click phải, click trái rồi chọn.. chọn... mà thôi chứ ai lại "thủ công" như cách của bạn?
(hình như bạn không biết dùng PivotTable thì phải?)
Bạn cứ tìm hiểu PivotTable đi, sẽ không phải hối hận đâu
Có rất nhiều sư phụ trên diễn đàn này (như thầy ptm0412) dùng PivotTable đến mức "xuất quỷ nhập thần". Riêng ta thì không mong đạt khả năng đó, chỉ cần học đủ dùng là ổn rồi
Cái hay của PivotTable là:
- Bạn chỉ cực 1 lần duy nhất rồi dùng mãi mãi. Bạn cứ ung dung pha ly cafe ngồi tán gẫu, dữ liệu có thêm bớt gì thì PivotTable cũng tự cập nhật cho bạn đầy đủ
- Tốc độ nhanh nhất so với tất cả các giải pháp khác (công thức hay VBA)
- Giao diện báo cáo rất đa dạng và thẫm mỹ, mặc sức mà lựa chọn
vân vân... và... mây mây...
Bạn cứ tìm hiểu PivotTable đi, sẽ không phải hối hận đâu
Có rất nhiều sư phụ trên diễn đàn này (như thầy ptm0412) dùng PivotTable đến mức "xuất quỷ nhập thần". Riêng ta thì không mong đạt khả năng đó, chỉ cần học đủ dùng là ổn rồi
Cái hay của PivotTable là:
- Bạn chỉ cực 1 lần duy nhất rồi dùng mãi mãi. Bạn cứ ung dung pha ly cafe ngồi tán gẫu, dữ liệu có thêm bớt gì thì PivotTable cũng tự cập nhật cho bạn đầy đủ
- Tốc độ nhanh nhất so với tất cả các giải pháp khác (công thức hay VBA)
- Giao diện báo cáo rất đa dạng và thẫm mỹ, mặc sức mà lựa chọn
vân vân... và... mây mây...
PivotTable là chức năng cực mạnh góp phần không nhỏ làm nên tên tuổi của Excel, nhưng thuần hóa PivotTable theo ý riêng như trong bài nầy không phải là vấn đề đơn giản lưu ý PivotTable làm kích thước file tăng lên đáng kể, nếu bảng tổng hợp nào cũng chơi PivotTable thì...
làm được như bạn có mấy người, mình không dùng PivotTable nên cũng không biết, thử bấm vào dấu +, - các dòng ngày tháng phía dưới biến mất, bấm chuột phải chuột trái lung tung, nắm trên nắm dưới kéo thả đủ chổ, bảng chạy tưng lên mà cũng không chịu ra, cuối cùng tắt file không lưu
làm được như bạn có mấy người, mình không dùng PivotTable nên cũng không biết, thử bấm vào dấu +, - các dòng ngày tháng phía dưới biến mất, bấm chuột phải chuột trái lung tung, nắm trên nắm dưới kéo thả đủ chổ, bảng chạy tưng lên mà cũng không chịu ra, cuối cùng tắt file không lưu
Không biết có thể học bạn à! (mọi thứ đều có trên mạng)
Mình tin rằng mình là người tệ nhất về vụ PivotTable và Chart (không tin cứ hỏi sư phụ ptm0412), vậy mà mình cũng "mò" được bài này (hú hồn) thì mình tin rằng những thành viên thông minh như bạn sẽ là chuyện nhỏ
-----------------------
Gợi ý thêm: Bài này mình không chèn PivotTable theo cách thông thường mà bấm tổ hợp phím Alt + D + P (mở PivotTable and PivotChart Wizard) rồi check mục Mutiple consolidation range ---> Next ---> Check mục I will create the page fields ---> Next ---> Chọn vùng NhapBan!$G$17:$U$10000 ---> Add ---> Next
Từ giờ bắt đầu kéo thả các kiểu để hiệu chỉnh (bằng cách kéo mục Column xuống dưới Row, chỉnh hiển thị trong PivotTable Option theo kiểu "Classic PivotTable layout")
Đại khái vậy!
Nay mai nếu các bạn vẫn chưa làm được và còn quan tâm, mình sẽ quay video toàn bộ quá trình gửi lên cho các bạn tham
Không biết có thể học bạn à! (mọi thứ đều có trên mạng)
Mình tin rằng mình là người tệ nhất về vụ PivotTable và Chart (không tin cứ hỏi sư phụ ptm0412), vậy mà mình cũng "mò" được bài này (hú hồn) thì mình tin rằng những thành viên thông minh như bạn sẽ là chuyện nhỏ
-----------------------
Gợi ý thêm: Bài này mình không chèn PivotTable theo cách thông thường mà bấm tổ hợp phím Alt + D + P (mở PivotTable and PivotChart Wizard) rồi check mục Mutiple consolidation range ---> Next ---> Check mục I will create the page fields ---> Next ---> Chọn vùng NhapBan!$G$17:$U$10000 ---> Add ---> Next
Từ giờ bắt đầu kéo thả các kiểu để hiệu chỉnh (bằng cách kéo mục Column xuống dưới Row, chỉnh hiển thị trong PivotTable Option theo kiểu "Classic PivotTable layout")
Đại khái vậy!
Nay mai nếu các bạn vẫn chưa làm được và còn quan tâm, mình sẽ quay video toàn bộ quá trình gửi lên cho các bạn tham
Không biết có thể học bạn à! (mọi thứ đều có trên mạng)
Mình tin rằng mình là người tệ nhất về vụ PivotTable và Chart (không tin cứ hỏi sư phụ ptm0412), vậy mà mình cũng "mò" được bài này (hú hồn) thì mình tin rằng những thành viên thông minh như bạn sẽ là chuyện nhỏ
-----------------------
Gợi ý thêm: Bài này mình không chèn PivotTable theo cách thông thường mà bấm tổ hợp phím Alt + D + P (mở PivotTable and PivotChart Wizard) rồi check mục Mutiple consolidation range ---> Next ---> Check mục I will create the page fields ---> Next ---> Chọn vùng NhapBan!$G$17:$U$10000 ---> Add ---> Next
Từ giờ bắt đầu kéo thả các kiểu để hiệu chỉnh (bằng cách kéo mục Column xuống dưới Row, chỉnh hiển thị trong PivotTable Option theo kiểu "Classic PivotTable layout")
Đại khái vậy!
Nay mai nếu các bạn vẫn chưa làm được và còn quan tâm, mình sẽ quay video toàn bộ quá trình gửi lên cho các bạn tham
Thầy ơi hình như PivotTable biết em nhưng em lại không biết nó. Làm mãi mà không ra được như bài của thầy.
Thầy có thể làm một Topic hướng dẫn về cái này được không ạ
Thầy ơi hình như PivotTable biết em nhưng em lại không biết nó. Làm mãi mà không ra được như bài của thầy.
Thầy có thể làm một Topic hướng dẫn về cái này được không ạ
PHP Code:
Sub CongSoLuongHangTungNgay()
Dim WF As Object, Rng As Range, sRng As Range, CSDL As Range, Sh As Worksheet
Dim MyFormat As String, MyAdd As String
Dim J As Integer, W As Integer, fCol As Byte, lCol As Byte, Rw As Long
Dim Dat As Date, SoNgay As Integer, Cot As Byte, DSm As Double
Sheets("NhapBan").Select: fCol = [s17].Column
Set Rng = Range([G18], [G18].End(xlDown))
MyFormat = Rng.NumberFormat: lCol = [s17].End(xlToRight).Column
Rng.NumberFormat = "mm/dd/yyyy": Rw = Rng.Rows.Count
Set WF = Application.WorksheetFunction
Dat = WF.Min(Rng): SoNgay = WF.Max(Rng) - Dat
ReDim dArr(1 To Rw * lCol, 1 To 3): Set Sh = ThisWorkbook.Worksheets("KQ")
Sh.[b5].CurrentRegion.Offset(1).ClearContents
Set CSDL = [g17].Resize(Rw + 9, fCol): Sh.[b5].Value = [g17]
For J = 0 To SoNgay
Set sRng = Rng.Find(Format(Dat + J, "mm/dd/yyyy"), , xlValues, xlWhole)
If Not sRng Is Nothing Then
MyAdd = sRng.Address
Do
For Cot = fCol To lCol
Sh.[b6].Value = Format(Dat + J, "mm/dd/yyyy")
DSm = WF.DSum(CSDL, Cells(17, Cot), Sh.[B5:B6])
If DSm > 0 Then
W = W + 1: dArr(W, 2) = Cells(17, Cot).Value
dArr(W, 1) = Format(Dat + J, "dd/MM/yyyy")
dArr(W, 3) = DSm + dArr(W, 3)
End If
Next Cot
' Set sRng = Rng.FindNext(sRng) '
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
Next J
If W Then
Sh.[a5].Resize(W, 3).Value = dArr()
End If
Rng.NumberFormat = MyFormat
End Sub
Dựa vào góp ý của anh và thầy Ba tê.Em thử sưa như thế này có được không anh:
Mã:
Sub Tonghop()
Dim Dic As Object, Tem As String
Dim sArr(), tArr(), dArr(1 To 65535, 1 To 3)
Dim i As Long, j As Long, K As Long, C As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("NhapBan")
C = .Range("IV17").End(xlToLeft).Column - 6
tArr = .Range("S17", .Range("IV17").End(xlToLeft)).Value
sArr = .Range("G18", .Range("G65535").End(3)).Resize(, C).Value
For i = 1 To UBound(sArr)
For j = 1 To UBound(tArr, 2)
If sArr(i, j + 12) <> Empty Then
Tem = sArr(i, 1) & "#" & tArr(1, j)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = sArr(i, 1)
dArr(K, 2) = tArr(1, j)
dArr(K, 3) = sArr(i, j + 12)
Else
dArr(Dic.Item(Tem), 3) = dArr(Dic.Item(Tem), 3) + sArr(i, j + 12)
End If
End If
Next j
Next i
End With
With Sheets("KQ")
With .Range("A5:C65535")
.ClearContents
.Borders.LineStyle = xlNone
End With
.Range("A5").Resize(K, 3) = dArr
With .Range("A5").Resize(K, 3)
.Borders.LineStyle = xlContinuous
.Borders(xlInsideHorizontal).Weight = xlHairline
End With
End With
End Sub
Code của bạn cho kết quả đúng như ở sheet KQ.
Từ code của bạn, tôi sửa lại để cho phù hợp với sheet MongMuon. Tôi đã sửa nhưng chưa được kết quả như mong muốn.
Các bạn vui lòng giúp tôi sửa code để kết quả chạy đúng như ở sheet MongMuon
Xin cảm ơn!
E cảm ơn thầy ạ!
Nghe thầy nói đến thầy ptm0412 có khả năng dùng PivotTable như vậy e cũng muốn được chứng kiến và học hỏi ạ,
Không biết trên diễn đàn có bài viết nào của thầy ptm0412 không ạ?
Vì công cụ thì nhiều người biết, nhưng giá trị nằm ở cách sử dụng của mỗi người ạ!
Code của bạn cho kết quả đúng như ở sheet KQ.
Từ code của bạn, tôi sửa lại để cho phù hợp với sheet MongMuon. Tôi đã sửa nhưng chưa được kết quả như mong muốn.
Các bạn vui lòng giúp tôi sửa code để kết quả chạy đúng như ở sheet MongMuon
Xin cảm ơn!
Option Explicit
Sub Tonghop()
Dim Dic As Object, Tem As String
Dim sArr(), tArr(), dArr(1 To 65535, 1 To 16)
Dim i As Long, j As Long, K As Long, C As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("NhapBan")
C = .Range("IV17").End(xlToLeft).Column - 6
tArr = .Range("S17", .Range("IV17").End(xlToLeft)).Value
sArr = .Range("G18", .Range("G65535").End(3)).Resize(, C).Value
For i = 1 To UBound(sArr)
For j = 1 To UBound(tArr, 2)
If sArr(i, j + 12) <> Empty Then
Tem = sArr(i, 1) & "#" & tArr(1, j)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = sArr(i, 1)
dArr(K, 10) = tArr(1, j)
dArr(K, 15) = sArr(i, j + 12)
Else
dArr(Dic.Item(Tem), 15) = dArr(Dic.Item(Tem), 15) + sArr(i, j + 12)
End If
End If
Next j
Next i
End With
With Sheets("KQ")
With .Range("A8:Q65535")
.ClearContents
.Borders.LineStyle = xlNone
End With
.Range("B8").Resize(K, 16) = dArr
With .Range("B8").Resize(K, 16)
.Borders.LineStyle = xlContinuous
.Borders(xlInsideHorizontal).Weight = xlHairline
End With
End With
End Sub
