Cộng dồn Mã hàng hàng hóa theo ngày (chuyển từ cột ngang sang cột dọc)

Liên hệ QC
A

AnhThu-1976

Thành viên tích cực
Tham gia
17/10/14
Bài viết
1,016
Được thích
163
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!
 

File đính kèm

  • CongTH.rar
    151.1 KB · Đọc: 44
Sắp xếp theo thời gian sắp xếp theo bầu chọn
AnhThu-1976 đã viết:
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!
Nhấp chuột vào đây để mở rộng...
Bạn thử dùng Sub này xem sao:
Mã: 
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
 
Upvote 0
PacificPR đã viết:
Dạ. Vì bạn ấy nói mã hàng còn nhiều nên em đưa xuống dòng 65535 anh ạ.
Nhấp chuột vào đây để mở rộng...

Nếu nhiều hơn 3 mã hàng thì các con số 15 trong này không chính xác:
PHP: 
sArr = .Range("G18", .Range("G65535").End(3)).Resize(, 15).Value
    For i = 1 To UBound(sArr)
        For j = 13 To 15
Phải cho nó là một biến nào đó khác con số cố định 15, ví dụ:
PHP: 
C = .Range("IV17").End(xlToLeft).Column - 6
 
Upvote 0
Ba Tê đã viết:
Nếu nhiều hơn 3 mã hàng thì các con số 15 trong này không chính xác:
PHP: 
sArr = .Range("G18", .Range("G65535").End(3)).Resize(, 15).Value
    For i = 1 To UBound(sArr)
        For j = 13 To 15
Phải cho nó là một biến nào đó khác con số cố định 15, ví dụ:
PHP: 
C = .Range("IV17").End(xlToLeft).Column - 6
Nhấp chuột vào đây để mở rộng...
Dạ vâng. Em cũng chưa tính đến cái đó thầy ạ
 
Upvote 0
PacificPR đã viết:
Dạ. Vì bạn ấy nói mã hàng còn nhiều nên em đưa xuống dòng 65535 anh ạ.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
HieuCD đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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)
 
Lần chỉnh sửa cuối:
Upvote 0
hoặc bạn có thể dùng 1 mảng lưu dữ liệu
Mã: 
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
 
Upvote 0
HieuCD đã viết:
hoặc bạn có thể dùng 1 mảng lưu dữ liệu
Mã: 
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
Nhấp chuột vào đây để mở rộng...
Cám ơn anh nhiều. Thật là hay quá
 
Upvote 0
Cám ơn anh HieuCD rất nhiều. Em đang học VBA qua diễn đàn. Có gì mong anh và các thầy chỉ thêm cho em nha./
 
Upvote 0
AnhThu-1976 đã viết:
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!
Nhấp chuột vào đây để mở rộng...

Bài này tôi thấy dùng PivotTable là ngon nhất. Dữ liệu càng nhiều thì càng thấy nó lợi hại
 
Upvote 0
Cảm ơn Các Thầy & anh chị đã giúp đỡ

ndu96081631 đã viết:
Bài này tôi thấy dùng PivotTable là ngon nhất. Dữ liệu càng nhiều thì càng thấy nó lợi hại
Nhấp chuột vào đây để mở rộng...
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?

NgàyHĐTKMã HàngTên hàngSố Lượng
01/01/17H00125
01/01/17H00215
01/01/17H00360
01/01/17H004100
02/01/17H00110
03/01/17H0015
03/01/17H00240
05/01/17H00240
05/01/17H00350
06/01/17H00110
06/01/17H00220
06/01/17H00320
10/01/17H00120
10/01/17H00240
10/01/17H00350
Nghĩa là Cột Mã hàng cách xa cột ngày 2 cột
Cột Số lượng cách cột Mã hàng 1 cột
Nếu như vậy thí code sau fải sửa làm sao?
Mã: 
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 có sửa (chỗ màu đỏ), nhưng nó báo lỗi
Mã: 
                    Dic.Add Tem, K
                    dArr(K, 1) = sArr(i, 1)
                   [COLOR=#ff0000][B] dArr(K, 2) = ""
                    dArr(K, 3) = ""[/B][/COLOR]
                    dArr(K, 4) = sArr(1, j)
                    [COLOR=#ff0000][B]dArr(K, 5) = ""[/B][/COLOR]
                    dArr(K, 6) = sArr(i, j)
Vậy Các Thầy & các bạn giúp giùm!
Em cảm ơn.
 
Upvote 0
AnhThu-1976 đã viết:
Cảm ơn Các Thầy & anh chị đã giúp đỡ

Em có sửa (chỗ màu đỏ), nhưng nó báo lỗi
Mã: 
                    Dic.Add Tem, K
                    dArr(K, 1) = sArr(i, 1)
                   [COLOR=#ff0000][B] dArr(K, 2) = ""
                    dArr(K, 3) = ""[/B][/COLOR]
                    dArr(K, 4) = sArr(1, j)
                    [COLOR=#ff0000][B]dArr(K, 5) = ""[/B][/COLOR]
                    dArr(K, 6) = sArr(i, j)
Vậy Các Thầy & các bạn giúp giùm!
Em cảm ơn.
Nhấp chuột vào đây để mở rộng...
Bác khai báo lại cái dArr thành dArr(1 To 65535, 1 To 6) .Vì Cái dArr hiện tại có 3 cột
 
Lần chỉnh sửa cuối:
Upvote 0
AnhThu-1976 đã viết:
Cảm ơn Các Thầy & anh chị đã giúp đỡ


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)
Nhấp chuột vào đây để mở rộng...
Không hiểu bạn nói bỏ bớt râu ria là gì cả
???
Bạn cần kết quả thế nào, tôi ra kết quả y chang thế thôi, có vấn đề gì chứ?

Capture.JPG
 

File đính kèm

  • CongTH.zip
    216.5 KB · Đọc: 11
Upvote 0
ndu96081631 đã viết:
Không hiểu bạn nói bỏ bớt râu ria là gì cả
???
Bạn cần kết quả thế nào, tôi ra kết quả y chang thế thôi, có vấn đề gì chứ?

View attachment 174822
Nhấp chuột vào đây để mở rộng...
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...
 
Upvote 0
AnhThu-1976 đã viết:
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...
Nhấp chuột vào đây để mở rộng...

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?)

Capture.JPG
 

File đính kèm

  • CongTH.xlsb
    105.8 KB · Đọc: 6
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

dungluf123
Lỗi khi sử dụng công thức để link từ file này sang file khác của Excel trên hệ thống mạng chung của công ty
Trả lời
0
Đọc
18
dungluf123
dungluf123
V
Tìm điều kiện sau đó tính tổng ma hang theo điều kiện
Trả lời
5
Đọc
46
vnproc
V
hongphuong1997
  • Question
Lấy ký tự trong chuỗi theo nhiều điều kiện
Trả lời
0
Đọc
23
hongphuong1997
hongphuong1997
P
HÀM SUBTOTAL BỊ #VALUE
Trả lời
1
Đọc
24
DeTong
D
phanmoi688
[Xin nhờ giúp đỡ] Tìm cách xóa các ký tự trắng trong biểu
Trả lời
4
Đọc
44
phanmoi688
phanmoi688
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom