Mừng Sinh Nhật GPE 11: sáng 25/6 Hà Nội; 1/7 Huế/Đà Nẵng; Trưa 2/7 TPHCM

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)

Thảo luận trong 'Lập Trình với Excel' bắt đầu bởi AnhThu-1976, 21 Tháng tư 2017.

  1. AnhThu-1976

    AnhThu-1976 Thành viên thường trực

    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 file đính kèm:

  2. PacificPR

    PacificPR Thành viên thường trực

    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
    
     
    AnhThu-1976 thích bài này.
  3. befaint

    befaint |||||||||||||

    Chỗ màu xanh sẽ làm cho vùng dữ liệu nhảy tới dòng 65535 --> Tăng dung lượng
     
    AnhThu-1976 thích bài này.
  4. PacificPR

    PacificPR Thành viên thường trực

    Dạ. Vì bạn ấy nói mã hàng còn nhiều nên em đưa xuống dòng 65535 anh ạ.
     
    AnhThu-1976 thích bài này.
  5. Ba Tê

    Ba Tê Cạo Rồi Khỏi Gội

    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 1 To UBound(sArr)
            For 
    13 To 15
    Phải cho nó là một biến nào đó khác con số cố định 15, ví dụ:
    PHP:
    = .Range("IV17").End(xlToLeft).Column 6
     
    AnhThu-1976 thích bài này.
  6. PacificPR

    PacificPR Thành viên thường trực

    Dạ vâng. Em cũng chưa tính đến cái đó thầy ạ
     
  7. HieuCD

    HieuCD Thành viên gắn bó

    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
     
    AnhThu-1976 thích bài này.
  8. PacificPR

    PacificPR Thành viên thường trực

    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
    
    
    
     
    AnhThu-1976 thích bài này.
  9. HieuCD

    HieuCD Thành viên gắn bó

    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: 21 Tháng tư 2017
    AnhThu-1976 thích bài này.
  10. HieuCD

    HieuCD Thành viên gắn bó

    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
     
    AnhThu-1976 thích bài này.
  11. Sharava36

    Sharava36 Thành viên sao chép

    Cám ơn anh nhiều. Thật là hay quá
     
  12. PacificPR

    PacificPR Thành viên thường trực

    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./
     
  13. ndu96081631

    ndu96081631 Ăn cùng GPE, Ở cùng GPE, Sống cùng GPE Staff Member Super Moderator

    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
     
    AnhThu-1976 thích bài này.
  14. AnhThu-1976

    AnhThu-1976 Thành viên thường trực

    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)

    Cho em hỏi thêm, nếu em muốn sheet KQ như sau thì sửa code như thế nào?

    Column1
    [TR]
    [TD="class: xl73, width: 64"]Ngày[/TD]
    [TD="class: xl73, width: 64"]HĐ[/TD]
    [TD="class: xl73, width: 64"]TK[/TD]
    [TD="class: xl73, width: 64"]Mã Hàng[/TD]
    [TD="class: xl73, width: 64"]Tên hàng[/TD]
    [TD="class: xl73, width: 64"]Số Lượng[/TD]
    [/TR]
    [TR]
    [TD="class: xl74, align: right"]01/01/17[/TD]
    [TD="class: xl74"][/TD]
    [TD="class: xl74"][/TD]
    [TD="class: xl75"]H001[/TD]
    [TD="class: xl75"][/TD]
    [TD="class: xl76, align: right"]25[/TD]
    [/TR]
    [TR]
    [TD="class: xl67, align: right"]01/01/17[/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl68"]H002[/TD]
    [TD="class: xl68"][/TD]
    [TD="class: xl69, align: right"]15[/TD]
    [/TR]
    [TR]
    [TD="class: xl67, align: right"]01/01/17[/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl68"]H003[/TD]
    [TD="class: xl68"][/TD]
    [TD="class: xl69, align: right"]60[/TD]
    [/TR]
    [TR]
    [TD="class: xl67, align: right"]01/01/17[/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl70"]H004[/TD]
    [TD="class: xl70"][/TD]
    [TD="class: xl69, align: right"]100[/TD]
    [/TR]
    [TR]
    [TD="class: xl67, align: right"]02/01/17[/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl70"]H001[/TD]
    [TD="class: xl70"][/TD]
    [TD="class: xl69, align: right"]10[/TD]
    [/TR]
    [TR]
    [TD="class: xl67, align: right"]03/01/17[/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl70"]H001[/TD]
    [TD="class: xl70"][/TD]
    [TD="class: xl69, align: right"]5[/TD]
    [/TR]
    [TR]
    [TD="class: xl67, align: right"]03/01/17[/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl68"]H002[/TD]
    [TD="class: xl68"][/TD]
    [TD="class: xl69, align: right"]40[/TD]
    [/TR]
    [TR]
    [TD="class: xl67, align: right"]05/01/17[/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl68"]H002[/TD]
    [TD="class: xl68"][/TD]
    [TD="class: xl69, align: right"]40[/TD]
    [/TR]
    [TR]
    [TD="class: xl67, align: right"]05/01/17[/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl68"]H003[/TD]
    [TD="class: xl68"][/TD]
    [TD="class: xl69, align: right"]50[/TD]
    [/TR]
    [TR]
    [TD="class: xl67, align: right"]06/01/17[/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl70"]H001[/TD]
    [TD="class: xl70"][/TD]
    [TD="class: xl69, align: right"]10[/TD]
    [/TR]
    [TR]
    [TD="class: xl67, align: right"]06/01/17[/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl68"]H002[/TD]
    [TD="class: xl68"][/TD]
    [TD="class: xl69, align: right"]20[/TD]
    [/TR]
    [TR]
    [TD="class: xl67, align: right"]06/01/17[/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl68"]H003[/TD]
    [TD="class: xl68"][/TD]
    [TD="class: xl69, align: right"]20[/TD]
    [/TR]
    [TR]
    [TD="class: xl67, align: right"]10/01/17[/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl70"]H001[/TD]
    [TD="class: xl70"][/TD]
    [TD="class: xl69, align: right"]20[/TD]
    [/TR]
    [TR]
    [TD="class: xl67, align: right"]10/01/17[/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl67"][/TD]
    [TD="class: xl70"]H002[/TD]
    [TD="class: xl70"][/TD]
    [TD="class: xl69, align: right"]40[/TD]
    [/TR]
    [TR]
    [TD="class: xl71, align: right"]10/01/17[/TD]
    [TD="class: xl71"][/TD]
    [TD="class: xl71"][/TD]
    [TD="class: xl77"]H003[/TD]
    [TD="class: xl72"][/TD]
    [TD="class: xl72, align: right"]50[/TD]
    [/TR]

    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.
     
  15. PacificPR

    PacificPR Thành viên thường trực

    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: 22 Tháng tư 2017
    AnhThu-1976 thích bài này.
  16. AnhThu-1976

    AnhThu-1976 Thành viên thường trực

    Cảm ơn bạn nhiều !!!!!!!!!!!!
     
  17. ndu96081631

    ndu96081631 Ăn cùng GPE, Ở cùng GPE, Sống cùng GPE Staff Member Super Moderator

    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
     

    Các file đính kèm:

    AnhThu-1976 thích bài này.
  18. AnhThu-1976

    AnhThu-1976 Thành viên thường trực

    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...
     
  19. ndu96081631

    ndu96081631 Ăn cùng GPE, Ở cùng GPE, Sống cùng GPE Staff Member Super Moderator

    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
     

    Các file đính kèm:

    AnhThu-1976 thích bài này.
  20. AnhThu-1976

    AnhThu-1976 Thành viên thường trực

    Em đang chập chững mà
     

Chia sẻ trang này