Diễn đàn giaiphapexcel.com sẽ chuyển sang hoạt động ở link sau

http://www.giaiphapexcel.com/diendan/forums


[CLICK] học VBA ở Đà Nẵng tháng 5/2017


Trang 1/3 1 2 3 cuốicuối
Hiển thị kết quả tìm kiếm từ 1 đến 10 trên tổng số: 30

Ðề tài: 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)

  1. 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)

    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!
    Tập tin đính kèm Tập tin đính kèm

  2. Trích Nguyên văn bởi AnhThu-1976 View Post
    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!
    Bạn thử dùng Sub này xem sao:
    Code:
    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

  3. Trích Nguyên văn bởi PacificPR View Post
    Bạn thử dùng Sub này xem sao:
    Code:
    Sub Tonghop()
    ....
        With .Range("A5:C65535")
            .ClearContents
            .Borders.LineStyle = xlNone
    ...
    End Sub
    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

  4. Trích Nguyên văn bởi befaint View Post
    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
    Dạ. Vì bạn ấy nói mã hàng còn nhiều nên em đưa xuống dòng 65535 anh ạ.

  5. Trích Nguyên văn bởi PacificPR View Post
    Dạ. Vì bạn ấy nói mã hàng còn nhiều nên em đưa xuống dòng 65535 anh ạ.
    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 Code:
    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 Code:
    = .Range("IV17").End(xlToLeft).Column 
    ------------------------


    --Bể dốt mênh mông, quay đầu... là bờ ?!

    Tra Cứu Hàm Excel
    Kỷ niệm Hà Nội 16/01/2010

  6. Trích Nguyên văn bởi Ba Tê View Post
    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 Code:
    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 Code:
    = .Range("IV17").End(xlToLeft).Column 
    Dạ vâng. Em cũng chưa tính đến cái đó thầy ạ

  7. Trích Nguyên văn bởi PacificPR View Post
    Dạ. Vì bạn ấy nói mã hàng còn nhiều nên em đưa xuống dòng 65535 anh ạ.
    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
    Code:
    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

  8. Trích Nguyên văn bởi HieuCD View Post
    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
    Code:
    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:
    Code:
    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

  9. 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
    Code:
    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")
    
        LastR = .Range("G18").End(xlDown).Row 'dòng cuoi
        C = .Range("IV17").End(xlToLeft).Column - 18  'só cot ma hàng
        tArr = .Range("G17:G" & LastR).Value  'Array ngày tháng
        sArr = .Range("S17:S" & LastR).Resize(, C).Value  'Array ma hàng
        For i = 2 To UBound(tArr)
            For j = 1 To UBound(sArr, 2)
                If sArr(i, j) <> Empty Then
                    Tem = tArr(i, 1) & "#" & sArr(1, j)
    ...
                     dArr(K, 3) = sArr(i, j)
    thay đổi nội dung bởi: HieuCD, 21-04-17 lúc 05:58 PM

  10. hoặc bạn có thể dùng 1 mảng lưu dữ liệu
    Code:
    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

Trang 1/3 1 2 3 cuốicuối

Thông tin về chủ đề này

Users Browsing this Thread

Hiện có 1 người đang xem đề tài này. (0 thành viên và 1 khách)

Bookmarks

Bookmarks

Quyền Sử Dụng Ở Diễn Ðàn

  • Bạn không thể đăng đề tài mới
  • Bạn không thể đăng trả lời
  • Bạn không thể đăng file đính kèm.
  • Bạn không thể sửa bài viết.
  •