Nhờ tối ưu mảng và vòng lặp lồng nhau cho file gần 300.000 dòng

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài
Có
H

hoaphin

Exemplary Сasual Dating Authentic Damsels
Tham gia
25/11/14
Bài viết
8
Được thích
1
Giới tính
Nam
Nghề nghiệp
Health
Xin chào các bác ạ,
- Em tàu ngầm formum đã lâu, nhưng chưa tìm ra phương án để chạy code cho file khoảng 300 nghìn dòng, nó phải chạy nửa ngày mất, chạy 1 vài nghìn dòng thì tạm được.
- Do vòng lặp lồng nhau nên em mới viết tạm được cột tính tổng trả từng loại để chạy thử như nào nhưng lâu quá nên chưa dám viết nốt các cột còn lại (cột số lũy kế (lũy kế là em tính ngược từ dòng cuối cùng lên) + chênh lệch + số xuất mới là em chưa viết)
- Ban đầu em chỉ có duy nhất 1 mảng nhưng do trong mảng có nhiều cột không dùng đến nên viết tách thành 3 mảng khác nhau, cột nào dùng em lấy cột đó thì code chạy đã nhanh hơn 1 tý, nhưng chạy khoảng 300.000 dòng là treo, đợi khoảng 1 tiếng chưa thấy chạy xong.

Xin nhờ các cao thủ giúp em với ạ
Chi tiết em up trong file đính kèm (file nặng nên em xóa bớt dòng đi, chỉ để mẫu tầm 200 dòng)
Mục tiêu là tính toán ra được cột số lượng xuất mới kia, các cột khác tính ngầm trong vba ạ
Đây là post đầu tiên của em, hi vọng admin duyệt giúp đỡ em ạ
Em cảm ơn!
Thông tin máy của em, ram 8gb
1682485019813.png
 

File đính kèm

  • Vong lap.xlsb
    648.4 KB · Đọc: 17
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
hoaphin đã viết:
Xin chào các các bác ạ,
- Em tàu ngầm formum đã lâu, nhưng chưa tìm ra phương án để chạy code cho file khoảng gần 300 nghìn dòng...
Nhấp chuột vào đây để mở rộng...
Lặn từ 2014 tới giờ chắc bí bách lắm nên giờ mới trồi lên...haha
Cột P là cột kết quả từ công thức
Cột R là kết quả từ VBA
2 cột này là 1, hay 2 cột khác nhau?
Vì cột A bạn để có 1 ngày duy nhất 4/1 nên mình không hiểu việc SUMIF từ dưới lên có ý nghĩa gì?
Bây giờ bạn tạo thêm 1 sheet, cho thêm 1 ngày nữa (3/1 hoặc 5/1), các cột phụ bên phải bỏ đi, chỉ để lại cột cần, điền tay kết quả 1 vài dòng xem sao.
 
Upvote 0
Có gì không phải mình xin lỗi trước, chứ lần đầu tiên mình tiếp xúc với kiểu
khai báo biến J của bạn ngày trong vòng lặp Fore i = . . . .Next i

PHP: 
 . . . .
For i = LBound(rngArr, 1) To UBound(rngArr, 1)
            Dim j As Long   '@@@@ $$$$'
            For j = LBound(rngArr, 1) To UBound(rngArr, 1)
                If rngArr1(i, 1) = rngArr1(j, 1) And rngArr2(i, 1) = rngArr2(j, 1) Then
                    outArr(i, 1) = outArr(i, 1) + rngArr3(j, 1)
                End If
            Next j
        Next i
. . . . .
Nếu là mình thì khai báo cho bằng hết các tham biến cần thiết ngay từ đầu chương trình;
Có 1 ngoại lệ là tham biến
Mã: 
ReDim outArr(1 To X, 1 To 1)
Sẽ phải khai báo ngay sau khi đã xác định được X (trong câu lệnh: X = .Cells(.Rows.Count, 1).End(xlUp).Row
 
Upvote 0
bebo021999 đã viết:
Lặn từ 2014 tới giờ chắc bí bách lắm nên giờ mới trồi lên...haha
Cột P là cột kết quả từ công thức
Cột R là kết quả từ VBA
2 cột này là 1, hay 2 cột khác nhau?
Vì cột A bạn để có 1 ngày duy nhất 4/1 nên mình không hiểu việc SUMIF từ dưới lên có ý nghĩa gì?
Bây giờ bạn tạo thêm 1 sheet, cho thêm 1 ngày nữa (3/1 hoặc 5/1), các cột phụ bên phải bỏ đi, chỉ để lại cột cần, điền tay kết quả 1 vài dòng xem sao.
Nhấp chuột vào đây để mở rộng...
Vâng, thú thực bí lắm em mới mang lên đây :(
1. Cái cột P là cột em cần tính đó bác, nhưng em viết code thì em chỉnh sang cột R để tránh mất công thức diễn giải để nhờ các bác giúp, chứ khi outrr tính xong là gán vào cột P chứ không phải là cột R => 2 cột này là 1 nha bác (nhưng hiện tại em mới viết được cột tổng trả từng dòng thôi ạ, đúng ra là viết cả lũy kế trả, chênh lệch xong ra được cái số xuất mới thì gán số xuất mới vào cột P là xong)
2. Phần cột lũy kế, bác F2 từ dòng thứ 2 trở đi là nó khác với cột tổng trả, vì file của em nó kéo dài từ năm 2021 đến năm 2023, bản chất là khi trả hàng thì sẽ phải trừ ngược từ hiện tại gần nhất trở về trước, em ví dụ: Bệnh viện A nhập hàng X năm 2021 là 10 (=>xuất cũ : 10), năm 2022 trả 6, năm 2023 nhập 2 (xuất cũ: 2) thì số xuất mới sẽ là: năm 2023 xuất 0 (do 2-6 <0 => xuất 0), năm 2022: xuất 0 do toàn trả hàng, năm 2021 xuất 6 do còn dư 4 cái năm 2023 chưa trừ hết.
Em ví dụ năm vậy thôi nhưng nó tính theo từng dòng đó ạ, cứ lấy dòng cuối cùng của loại hàng trả, bệnh viện trả xong trừ ngược dần đi
Em đã bổ sung file các ngày tiếp theo rồi đó ạ, mong bác giúp em
Bài đã được tự động gộp:

SA_DQ đã viết:
Có gì không phải mình xin lỗi trước, chứ lần đầu tiên mình tiếp xúc với kiểu
khai báo biến J của bạn ngày trong vòng lặp Fore i = . . . .Next i

PHP: 
 . . . .
For i = LBound(rngArr, 1) To UBound(rngArr, 1)
            Dim j As Long   '@@@@ $$$$'
            For j = LBound(rngArr, 1) To UBound(rngArr, 1)
                If rngArr1(i, 1) = rngArr1(j, 1) And rngArr2(i, 1) = rngArr2(j, 1) Then
                    outArr(i, 1) = outArr(i, 1) + rngArr3(j, 1)
                End If
            Next j
        Next i
. . . . .
Nếu là mình thì khai báo cho bằng hết các tham biến cần thiết ngay từ đầu chương trình;
Có 1 ngoại lệ là tham biến
Mã: 
ReDim outArr(1 To X, 1 To 1)
Sẽ phải khai báo ngay sau khi đã xác định được X (trong câu lệnh: X = .Cells(.Rows.Count, 1).End(xlUp).Row
Nhấp chuột vào đây để mở rộng...
Dạ vâng, em xin ghi nhận ý kiến của bác ạ, để em chính lại phần ReDim outArr
 

File đính kèm

  • Vong lap.xlsb
    648.4 KB · Đọc: 16
Lần chỉnh sửa cuối:
Upvote 0
hoaphin đã viết:
Mục tiêu là tính toán ra được cột số lượng xuất mới kia
Nhấp chuột vào đây để mở rộng...
Bạn thử xem sao.
Mã: 
Sub Test()
    Range("R2:R259").Value = aXuatMoi(Range("D2:D259").Value, Range("G2:G259").Value, Range("K2:K259").Value, Range("L2:L259").Value)
End Sub
Function aXuatMoi(aMaKhach As Variant, aMaVT As Variant, aXuat As Variant, aTra As Variant) As Variant
    Dim oDic As Object, sMa As String, aTongTra As Variant, aKQ As Variant, i As Long, n As Long, k As Long
    Set oDic = CreateObject("Scripting.Dictionary")
    ReDim aTongTra(1 To 1)
    For i = 1 To UBound(aTra, 1)
        If aTra(i, 1) <> 0 Then
            sMa = aMaKhach(i, 1) & "|" & aMaVT(i, 1)
            If oDic.Exists(sMa) Then
                k = oDic.Item(sMa)
            Else
                n = n + 1
                ReDim Preserve aTongTra(1 To n)
                oDic.Add sMa, n
                k = n
            End If
            aTongTra(k) = aTongTra(k) + aTra(i, 1)
        End If
    Next
    ReDim aKQ(1 To UBound(aTra, 1), 1 To 1)
    For i = UBound(aTra, 1) To 1 Step -1
        sMa = aMaKhach(i, 1) & "|" & aMaVT(i, 1)
        If oDic.Exists(sMa) Then
            k = oDic.Item(sMa)
            If aXuat(i, 1) >= aTongTra(k) Then
                aKQ(i, 1) = aXuat(i, 1) - aTongTra(k)
                oDic.Remove sMa
            Else
                aTongTra(k) = aTongTra(k) - aXuat(i, 1)
                aKQ(i, 1) = 0
            End If
        Else
            aKQ(i, 1) = aXuat(i, 1)
        End If
    Next
    aXuatMoi = aKQ
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
huuthang_bd đã viết:
Bạn thử xem sao.
Mã: 
Sub Test()
    Range("R2:R259").Value = aXuatMoi(Range("D2:D259").Value, Range("G2:G259").Value, Range("K2:K259").Value, Range("L2:L259").Value)
End Sub
Function aXuatMoi(aMaKhach As Variant, aMaVT As Variant, aXuat As Variant, aTra As Variant) As Variant
    Dim oDic As Object, sMa As String, aTongTra As Variant, aKQ As Variant, i As Long, n As Long, k As Long
    Set oDic = CreateObject("Scripting.Dictionary")
    ReDim aTongTra(1 To 1)
    For i = 1 To UBound(aTra, 1)
        If aTra(i, 1) <> 0 Then
            sMa = aMaKhach(i, 1) & "|" & aMaVT(i, 1)
            If oDic.Exists(sMa) Then
                k = oDic.Item(sMa)
            Else
                n = n + 1
                ReDim Preserve aTongTra(1 To n)
                oDic.Add sMa, n
                k = n
            End If
            aTongTra(k) = aTongTra(k) + aTra(i, 1)
        End If
    Next
    ReDim aKQ(1 To UBound(aTra, 1), 1 To 1)
    For i = UBound(aTra, 1) To 1 Step -1
        sMa = aMaKhach(i, 1) & "|" & aMaVT(i, 1)
        If oDic.Exists(sMa) Then
            k = oDic.Item(sMa)
            If aXuat(i, 1) >= aTongTra(k) Then
                aKQ(i, 1) = aXuat(i, 1) - aTongTra(k)
                oDic.Remove sMa
            Else
                aTongTra(k) = aTongTra(k) - aKQ(i, 1)
                aKQ(i, 1) = 0
            End If
        Else
            aKQ(i, 1) = aXuat(i, 1)
        End If
    Next
    aXuatMoi = aKQ
End Function
Nhấp chuột vào đây để mở rộng...
Code của bác chạy siêu nhanh. Cảm ơn bác đã hỗ trợ em nhiều ạ.
 
Upvote 0
huuthang_bd đã viết:
Bạn thử xem sao.
Mã: 
Sub Test()
    Range("R2:R259").Value = aXuatMoi(Range("D2:D259").Value, Range("G2:G259").Value, Range("K2:K259").Value, Range("L2:L259").Value)
End Sub
Function aXuatMoi(aMaKhach As Variant, aMaVT As Variant, aXuat As Variant, aTra As Variant) As Variant
    Dim oDic As Object, sMa As String, aTongTra As Variant, aKQ As Variant, i As Long, n As Long, k As Long
    Set oDic = CreateObject("Scripting.Dictionary")
    ReDim aTongTra(1 To 1)
    For i = 1 To UBound(aTra, 1)
        If aTra(i, 1) <> 0 Then
            sMa = aMaKhach(i, 1) & "|" & aMaVT(i, 1)
            If oDic.Exists(sMa) Then
                k = oDic.Item(sMa)
            Else
                n = n + 1
                ReDim Preserve aTongTra(1 To n)
                oDic.Add sMa, n
                k = n
            End If
            aTongTra(k) = aTongTra(k) + aTra(i, 1)
        End If
    Next
    ReDim aKQ(1 To UBound(aTra, 1), 1 To 1)
    For i = UBound(aTra, 1) To 1 Step -1
        sMa = aMaKhach(i, 1) & "|" & aMaVT(i, 1)
        If oDic.Exists(sMa) Then
            k = oDic.Item(sMa)
            If aXuat(i, 1) >= aTongTra(k) Then
                aKQ(i, 1) = aXuat(i, 1) - aTongTra(k)
                oDic.Remove sMa
            Else
                aTongTra(k) = aTongTra(k) - aKQ(i, 1)
                aKQ(i, 1) = 0
            End If
        Else
            aKQ(i, 1) = aXuat(i, 1)
        End If
    Next
    aXuatMoi = aKQ
End Function
Nhấp chuột vào đây để mở rộng...
Bác ơi, em chạy thử thì code nhanh nhưng kết quả thì lại sai ạ, bác xem lại giúp em cái chỗ so sánh thì mình dùng lũy kế xuất dòng i so sánh với tổng trả tại dòng i thì ra được được kết quả ạ (mà trong file em dùng là cột chênh lệch giữa lũy kế xuất - tổng trả ) hoặc em có viết bằng công thức diễn giải trong file ạ
1682505629515.png
Em ví dụ file có 10 dòng:
Lũy kế xuất tại dòng thứ 6, lũy kế xuất được tính tổng của những mã vật tư cùng xuất cho 1 bệnh viện từ dòng 6 đến dòng 10 (vì trả là sẽ trừ ngược từ hiện tại về quá khứ, hết số trả thì thôi nên phải tổng ngược từ dưới lên)
Lũy kế xuất tại dòng thứ 5, lũy kế xuất được tính tổng của những mã vật tư cùng xuất cho 1 bệnh viện từ dòng 5 đến dòng 10
Lũy kế xuất tại dòng thứ 4, lũy kế xuất được tính tổng của những mã vật tư cùng xuất cho 1 bệnh viện từ dòng 4 đến dòng 10
 
Lần chỉnh sửa cuối:
Upvote 0
hoaphin đã viết:
Bác ơi, em chạy thử thì code nhanh nhưng kết quả thì lại sai ạ
Nhấp chuột vào đây để mở rộng...
Có chút nhầm lẫn. Bạn sửa chỗ màu đỏ lại.
Rich (BB code): 
            ...
            If aXuat(i, 1) >= aTongTra(k) Then
                aKQ(i, 1) = aXuat(i, 1) - aTongTra(k)
                oDic.Remove sMa
            Else
                aTongTra(k) = aTongTra(k) - aXuat(i, 1)
                aKQ(i, 1) = 0
            End If
            ...
Code ở bài #5 cũng đã được sửa lại.
 
Upvote 0
Em cảm ơn bác, kết quả chuẩn luôn rồi ạ
huuthang_bd đã viết:
Có chút nhầm lẫn. Bạn sửa chỗ màu đỏ lại.
Rich (BB code): 
            ...
            If aXuat(i, 1) >= aTongTra(k) Then
                aKQ(i, 1) = aXuat(i, 1) - aTongTra(k)
                oDic.Remove sMa
            Else
                aTongTra(k) = aTongTra(k) - aXuat(i, 1)
                aKQ(i, 1) = 0
            End If
            ...
Code ở bài #5 cũng đã được sửa lại.
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
huuthang_bd đã viết:
Có chút nhầm lẫn. Bạn sửa chỗ màu đỏ lại.
Rich (BB code): 
            ...
            If aXuat(i, 1) >= aTongTra(k) Then
                aKQ(i, 1) = aXuat(i, 1) - aTongTra(k)
                oDic.Remove sMa
            Else
                aTongTra(k) = aTongTra(k) - aXuat(i, 1)
                aKQ(i, 1) = 0
            End If
            ...
Code ở bài #5 cũng đã được sửa lại.
Nhấp chuột vào đây để mở rộng...
Bác ơi, em nhờ bác chỉnh lại 1 chút code để theo công thức mới được ko ạ? em sẽ cảm ơn bác, mong bác giúp đỡ, em ngồi viết mãi mà chưa sửa lại được code hôm trước của bác cho ra đúng yêu cầu mới:
Ghi chú em nêu trong file ạ, túm lại là lấy từ dòng trả trừ ngược về trước lên trên của số lượng xuất cùng mặt hàng và cùng mã khách ạ
1684042290675.png
 

File đính kèm

  • Tinh luong xuat moi.xlsb
    23.7 KB · Đọc: 10
Lần chỉnh sửa cuối:
Upvote 0
hoaphin đã viết:
Bác ơi, em nhờ bác chỉnh lại 1 chút code để theo công thức mới được ko ạ? em sẽ cảm ơn bác, mong bác giúp đỡ, em ngồi viết mãi mà chưa sửa lại được code hôm trước của bác cho ra đúng yêu cầu mới:
Ghi chú em nêu trong file ạ, túm lại là lấy từ dòng trả trừ ngược về trước lên trên của số lượng xuất cùng mặt hàng và cùng mã khách ạ
Nhấp chuột vào đây để mở rộng...
Bạn thử code này xem:
Mã: 
Sub Test()
    Range("P2:P19").Value = aXuatMoi(Range("D2:D19").Value, Range("G2:G19").Value, Range("K2:K19").Value, Range("L2:L19").Value)
End Sub
Function aXuatMoi(aMaKhach As Variant, aMaVT As Variant, aXuat As Variant, aTra As Variant) As Variant
    Dim oDic As Object, sMa As String, aTongTra As Variant, aKQ As Variant, i As Long, n As Long, k As Long
    Set oDic = CreateObject("Scripting.Dictionary")
    ReDim aTongTra(1 To 1)
    ReDim aKQ(1 To UBound(aTra, 1), 1 To 1)
    For i = UBound(aTra, 1) To 1 Step -1
        sMa = aMaKhach(i, 1) & "|" & aMaVT(i, 1)
        If aTra(i, 1) <> 0 Then
            If oDic.Exists(sMa) Then
                k = oDic.Item(sMa)
                aTongTra(k) = aTongTra(k) + aTra(i, 1)
            Else
                n = n + 1
                ReDim Preserve aTongTra(1 To n)
                oDic.Add sMa, n
                aTongTra(n) = aTra(i, 1)
            End If
        ElseIf aXuat(i, 1) <> 0 Then
            If oDic.Exists(sMa) Then
                k = oDic.Item(sMa)
                If aXuat(i, 1) > aTongTra(k) Then
                    aKQ(i, 1) = aXuat(i, 1) - aTongTra(k)
                    aTongTra(k) = 0
                Else
                    aTongTra(k) = aTongTra(k) - aXuat(i, 1)
                    'aKQ(i, 1) = 0
                End If
            Else
                aKQ(i, 1) = aXuat(i, 1)
            End If
        End If
    Next
    aXuatMoi = aKQ
End Function
 
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

A
Công thức tính tổng chi phí nhiều điều kiện
Trả lời
0
Đọc
1
adad
A
C
Tiếng Việt
    • Cười
2
Trả lời
27
Đọc
1K
huuthang_bd
huuthang_bd
Q
Giúp em xử lý lỗi macro khi chạy VBA
Trả lời
15
Đọc
264
huhumalu
H
H
Cộng các ô cùng màu bằng VBA
Trả lời
1
Đọc
8
huhumalu
H
ptm0412
  • Question
Tài liệu hướng dẫn Power query cơ bản và nâng cao
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
3
Đọc
7K
trieunguyenkimtu
T
T
Chèn dữ liệu từ sheet này qua sheet khác theo điều kiện
Trả lời
0
Đọc
16
Thulib
T
nguyenanhhoa
Nhờ các bác giúp: e muốn tô màu khác nhau đối với các ô giống nhau về giá trị
Trả lời
0
Đọc
17
nguyenanhhoa
nguyenanhhoa
D
Thêm code VBA tính số lượng đã xuất và tồn cuối theo FIFO lô hàng
Trả lời
5
Đọc
164
huuthang_bd
huuthang_bd
T
Ký tự đặc biệt đại diện cho các ký tự khác trong vba là gì
Trả lời
4
Đọc
97
huhumalu
H
C
Xin code vba hàm vlookup
Trả lời
1
Đọc
486
duykhanh3488
D
hoamattroicoi
Thông tin dự kiến mở lớp học VBA căn bản ở Hải Phòng
    • Thích
    • Ngạc nhiên
    • Yêu thích
2
Trả lời
37
Đọc
23K
duykhanh3488
D
P
Lỗi : chỉ tự động định dạng ngày tháng nếu nhấp double click vào ô.
Trả lời
5
Đọc
10K
duykhanh3488
D
T
Tính tổng có điều kiện cho nhiều sheet trên excel
Trả lời
5
Đọc
78
duykhanh3488
D
D
KINDER SHARE 16yo GIRLS Paradise Birds
Trả lời
0
Đọc
25
duykhanh3488
D
befaint
Chia sẻ tâm tư, xả nỗi lòng
    • Thích
36 37 38
Trả lời
758
Đọc
46K
VetMini
V
PhanTuHuong
Miền Tây mùa nước nổi
    • Thích
    • Ngạc nhiên
2
Trả lời
29
Đọc
954
VetMini
V
T
cả nhà hỗ trợ giúp em là em phải dùng hàm gì cho đúng ạ, em làm mãi không được
    • Cười
Trả lời
1
Đọc
49
VetMini
V
jenny12345
tổng hợp dữ liệu theo tháng
Trả lời
14
Đọc
425
VetMini
V
N
Bỏ "hẳn" chế độ Markup trong Word đi như thế nào
2
Trả lời
21
Đọc
269K
superstar1612
superstar1612
danduy1711
Nhờ mn hỗ trợ chỉnh code VBA này, để cho ra kết quả đã lọc trùng.
Trả lời
5
Đọc
93
Phuocam
Phuocam
Xem thêm…

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