Dùng VBA cho file Nhập-Xuất-Tồn thay cho công thức (vì quá nặng)

Liên hệ QC
H

hoangtuaotrang_hp_vn

Thành viên tích cực
Tham gia
17/5/09
Bài viết
992
Được thích
864
Em chào anh/chị,

Nhờ công thức của anh/chị trên diễn đàn, em tự làm được file theo dõi Nhập-Xuất-Tồn bằng các hàm, tuy nhiên nếu dữ liệu nhiều hơn thì file chạy rất chậm

Mong anh/chị giúp em làm VBA để cho file nhanh và nhẹ hơn ạ,

Cụ thể:

1. Sheet In Out Daily: là sheet em nhập dữ liệu hàng ngày
2. Sheet Lookup: dùng để tra cứu tồn kho. Khi chọn ngày tra cứu ở C2 (From) và C3 (To)
- thì vùng từ A7:G10000 (hoặc lớn hơn, tùy dữ liệu): sẽ lọc dữ liệu (lọc duy nhất theo các mã hàng) về lượng tồn đầu (begin), nhập (Input), xuất (Output), tồn cuối (Inventory)
- Vùng D3:G3 sẽ lọc dữ liệu theo ngày ở C2,C3 và thêm 1 điều kiện mã hàng ở A3 nữa
3. Sheet Input-Output-Inventory:
Chọn năm cần xem ở C1 => tự động lọc ra (lọc theo các mã duy nhất) theo cấu trúc của sheet


Em chân thành cảm ơn anh/chị
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
hoangtuaotrang_hp_vn đã viết:
Em chào anh/chị,

Nhờ công thức của anh/chị trên diễn đàn, em tự làm được file theo dõi Nhập-Xuất-Tồn bằng các hàm, tuy nhiên nếu dữ liệu nhiều hơn thì file chạy rất chậm

Mong anh/chị giúp em làm VBA để cho file nhanh và nhẹ hơn ạ,

Cụ thể:

1. Sheet In Out Daily: là sheet em nhập dữ liệu hàng ngày
2. Sheet Lookup: dùng để tra cứu tồn kho. Khi chọn ngày tra cứu ở C2 (From) và C3 (To)
- thì vùng từ A7:G10000 (hoặc lớn hơn, tùy dữ liệu): sẽ lọc dữ liệu (lọc duy nhất theo các mã hàng) về lượng tồn đầu (begin), nhập (Input), xuất (Output), tồn cuối (Inventory)
- Vùng D3:G3 sẽ lọc dữ liệu theo ngày ở C2,C3 và thêm 1 điều kiện mã hàng ở A3 nữa
3. Sheet Input-Output-Inventory:
Chọn năm cần xem ở C1 => tự động lọc ra (lọc theo các mã duy nhất) theo cấu trúc của sheet


Em chân thành cảm ơn anh/chị
Nhấp chuột vào đây để mở rộng...
Ô nào có công thức thì thay bằng VBA, ô nào có dữ liệu sẵn thì nhập thủ công?
Công thức trong các cột là chính xác không?
 
Upvote 0
Ba Tê đã viết:
Ô nào có công thức thì thay bằng VBA, ô nào có dữ liệu sẵn thì nhập thủ công?
Công thức trong các cột là chính xác không?
Nhấp chuột vào đây để mở rộng...

Dạ, cháu muốn 2 sheet sau sẽ được lọc tự động ấy chú :
1. Input-Output-Inventory (sheet này: cột B và C đáng ra phải được lọc tự động-bỏ trùng, nhưng vì cháu không biết xử lý nên mới copy bằng tay từ sheet In-Out Daily sang ạ)
2. Lookup

tính đến thời điểm này thì công thức vẫn chính xác chú à :D

Có gì chú giúp cháu với, nhiều cái cháu chưa biết chú chỉ thêm cho cháu với ạ :)
 
Lần chỉnh sửa cuối:
Upvote 0
mình có một vấn đề, mong mọi người giúp đỡ. 1 thùng sữa có 48 hộp, VD trong bảng tính A1: 1542 hộp sữa. bây giờ mình chia A1/48 để tính ra thùng và số hộp sữa lẻ, 1542/48 = 32,125. vậy là được 32 thùng sữa, nhưng còn số lẻ la 0.125, 0.125 * 48 = 6 hộp, có cách nào, hàm nào tính một phát được luôn không mọi người?
 
Upvote 0
Thieutienty010286 đã viết:
mình có một vấn đề, mong mọi người giúp đỡ. 1 thùng sữa có 48 hộp, VD trong bảng tính A1: 1542 hộp sữa. bây giờ mình chia A1/48 để tính ra thùng và số hộp sữa lẻ, 1542/48 = 32,125. vậy là được 32 thùng sữa, nhưng còn số lẻ la 0.125, 0.125 * 48 = 6 hộp, có cách nào, hàm nào tính một phát được luôn không mọi người?
Nhấp chuột vào đây để mở rộng...
Hàm mod bạn nhé.
 
Lần chỉnh sửa cuối:
Upvote 0
Thieutienty010286 đã viết:
mình có một vấn đề, mong mọi người giúp đỡ. 1 thùng sữa có 48 hộp, VD trong bảng tính A1: 1542 hộp sữa. bây giờ mình chia A1/48 để tính ra thùng và số hộp sữa lẻ, 1542/48 = 32,125. vậy là được 32 thùng sữa, nhưng còn số lẻ la 0.125, 0.125 * 48 = 6 hộp, có cách nào, hàm nào tính một phát được luôn không mọi người?
Nhấp chuột vào đây để mở rộng...
Cụ thể tại cell B1=ROUND(A1/48;0)&" thùng " & MOD(A1;48) &" hộp"
 
Upvote 0
Thieutienty010286 đã viết:
mình có một vấn đề, mong mọi người giúp đỡ. 1 thùng sữa có 48 hộp, VD trong bảng tính A1: 1542 hộp sữa. bây giờ mình chia A1/48 để tính ra thùng và số hộp sữa lẻ, 1542/48 = 32,125. vậy là được 32 thùng sữa, nhưng còn số lẻ la 0.125, 0.125 * 48 = 6 hộp, có cách nào, hàm nào tính một phát được luôn không mọi người?
Nhấp chuột vào đây để mở rộng...
PHP: 
=INT((A1)/48)&"thùng"&"-"&MOD(A1,48)&"hộp"
 
Upvote 0
hoangtuaotrang_hp_vn đã viết:
Em chào anh/chị,

Nhờ công thức của anh/chị trên diễn đàn, em tự làm được file theo dõi Nhập-Xuất-Tồn bằng các hàm, tuy nhiên nếu dữ liệu nhiều hơn thì file chạy rất chậm

Mong anh/chị giúp em làm VBA để cho file nhanh và nhẹ hơn ạ,

Cụ thể:

1. Sheet In Out Daily: là sheet em nhập dữ liệu hàng ngày
2. Sheet Lookup: dùng để tra cứu tồn kho. Khi chọn ngày tra cứu ở C2 (From) và C3 (To)
- thì vùng từ A7:G10000 (hoặc lớn hơn, tùy dữ liệu): sẽ lọc dữ liệu (lọc duy nhất theo các mã hàng) về lượng tồn đầu (begin), nhập (Input), xuất (Output), tồn cuối (Inventory)
- Vùng D3:G3 sẽ lọc dữ liệu theo ngày ở C2,C3 và thêm 1 điều kiện mã hàng ở A3 nữa
3. Sheet Input-Output-Inventory:
Chọn năm cần xem ở C1 => tự động lọc ra (lọc theo các mã duy nhất) theo cấu trúc của sheet


Em chân thành cảm ơn anh/chị
Nhấp chuột vào đây để mở rộng...
Gửi bạn.
 

File đính kèm

Upvote 0
snow25 đã viết:
Gửi bạn.
Nhấp chuột vào đây để mở rộng...
anh ơi, kết quả chưa ra như mong đợi ạ,
1. Cột Date: sao lại không hiển thị được ngày tháng ạ?
2. Nguyên tắc là:
- Khi chọn từ ngày x đến ngày y, thì sẽ list ra từng ngày (từ ngày x đến ngày y) xem mỗi ngày có bao nhiêu mã hàng, lượng tồn đầu, nhập, xuất của mã đó theo từng ngày (trong cùng 1 ngày mà mã đó nhập xuất nhiều lần thì sẽ được lọc trùng, lượng nhập/xuất được tính gộp cho ngày hôm đó)
- Inventory của ngày đầu sẽ chính là chính là Begin của ngày tiếp theo

Nói tóm lại là: Kết quả em muốn được hiển thị giống i hệt bên dùng công thức anh à (anh xem ví dụ trên file hộ em với)
 

File đính kèm

Upvote 0
hoangtuaotrang_hp_vn đã viết:
anh ơi, kết quả chưa ra như mong đợi ạ,
1. Cột Date: sao lại không hiển thị được ngày tháng ạ?
2. Nguyên tắc là:
- Khi chọn từ ngày x đến ngày y, thì sẽ list ra từng ngày (từ ngày x đến ngày y) xem mỗi ngày có bao nhiêu mã hàng, lượng tồn đầu, nhập, xuất của mã đó theo từng ngày (trong cùng 1 ngày mà mã đó nhập xuất nhiều lần thì sẽ được lọc trùng, lượng nhập/xuất được tính gộp cho ngày hôm đó)
- Inventory của ngày đầu sẽ chính là chính là Begin của ngày tiếp theo

Nói tóm lại là: Kết quả em muốn được hiển thị giống i hệt bên dùng công thức anh à (anh xem ví dụ trên file hộ em với)
Nhấp chuột vào đây để mở rộng...
Đây bạn xem.
Mã: 
Sub tinhtonkho()
    Dim a As Long, b As Double, lr As Long, c As Long, i As Long, d As Long
    Dim arr, arr1
    Dim dk As String, dks As String
    Dim dic As Object, dic1 As Object
    Dim edate As Date, fdate As Date
    Set dic = CreateObject("scripting.dictionary")
    Set dic1 = CreateObject("scripting.dictionary")
    With Sheets("In-Out Daily")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 6 Then MsgBox "khong co du lieu": Exit Sub
         arr = .Range("A6:h" & lr).Value
         ReDim arr1(1 To UBound(arr, 1), 1 To 7)
    End With
    With Sheets("Lookup")
        edate = .Range("C2").Value
        fdate = .Range("C3").Value
        For i = 1 To UBound(arr, 1)
            If CLng(arr(i, 2)) < CLng(edate) Then
               dk = arr(i, 3)
               If dic.exists(dk) = 0 Then
                  If UCase(arr(i, 7)) = UCase("input") Then
                      dic.Item(dk) = Array(arr(i, 5))
                  Else
                      dic.Item(dk) = Array(-arr(i, 5))
                  End If
               Else
                  b = dic.Item(dk)(0)
                  If UCase(arr(i, 7)) = UCase("input") Then
                      b = b + arr(i, 5)
                  Else
                     b = b - arr(i, 5)
                  End If
                  dic.Item(dk) = Array(b)
               End If
           End If
        Next i
        For i = 1 To UBound(arr, 1)
           If CLng(arr(i, 2)) >= CLng(edate) And CLng(arr(i, 2)) <= CLng(fdate) Then
               dk = arr(i, 3)
               dks = arr(i, 2) & arr(i, 3)
                If dic.exists(dk) Then
                       If dic.exists(dks) = 0 Then
                             a = a + 1
                             arr1(a, 1) = a
                             arr1(a, 2) = arr(i, 2)
                             arr1(a, 3) = arr(i, 3)
                             arr1(a, 4) = dic.Item(dk)(0)
                          If UCase(arr(i, 7)) = UCase("input") Then arr1(a, 5) = arr(i, 5) Else arr1(a, 6) = arr(i, 5)
                             arr1(a, 7) = arr1(a, 4) + arr1(a, 5) - arr1(a, 6)
                             dic.Item(dks) = Array(a)
                             dic.Item(dk) = Array(arr1(a, 7))
                        Else
                            d = dic.Item(dks)(0)
                           If UCase(arr(i, 7)) = UCase("input") Then arr1(d, 5) = arr1(d, 5) + arr(i, 5) Else arr1(d, 6) = arr1(d, 6) + arr(i, 5)
                             arr1(d, 7) = arr1(d, 4) + arr1(d, 5) - arr1(d, 6)
                             dic.Item(dk) = Array(arr1(d, 7))
                        End If
               Else
                        If dic.exists(dks) = 0 Then
                             a = a + 1
                             arr1(a, 1) = a
                             arr1(a, 2) = arr(i, 2)
                             arr1(a, 3) = arr(i, 3)
                             arr1(a, 4) = Empty
                          If UCase(arr(i, 7)) = UCase("input") Then arr1(a, 5) = arr(i, 5) Else arr1(a, 6) = arr(i, 5)
                             arr1(a, 7) = arr1(a, 4) + arr1(a, 5) - arr1(a, 6)
                             dic.Item(dks) = Array(a)
                             dic.Item(dk) = Array(arr1(a, 7))
                        Else
                            d = dic.Item(dks)(0)
                            If UCase(arr(i, 7)) = UCase("input") Then arr1(d, 5) = arr1(d, 5) + arr(i, 5) Else arr1(d, 6) = arr1(d, 6) + arr(i, 5)
                             arr1(d, 7) = arr1(d, 4) + arr1(d, 5) - arr1(d, 6)
                             dic.Item(dk) = Array(arr1(d, 7))
                        End If
                End If
            End If
        Next i
       c = .Range("P" & Rows.Count).End(xlUp).Row
       If c > 7 Then .Range("P7:P" & c).Resize(, 7).ClearContents
       If a Then .Range("p7").Resize(a, 7).Value = arr1
End With


End Sub
 

File đính kèm

Upvote 0
snow25 đã viết:
Đây bạn xem.
Mã: 
Sub tinhtonkho()
    Dim a As Long, b As Double, lr As Long, c As Long, i As Long, d As Long
    Dim arr, arr1
    Dim dk As String, dks As String
    Dim dic As Object, dic1 As Object
    Dim edate As Date, fdate As Date
    Set dic = CreateObject("scripting.dictionary")
    Set dic1 = CreateObject("scripting.dictionary")
    With Sheets("In-Out Daily")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 6 Then MsgBox "khong co du lieu": Exit Sub
         arr = .Range("A6:h" & lr).Value
         ReDim arr1(1 To UBound(arr, 1), 1 To 7)
    End With
    With Sheets("Lookup")
        edate = .Range("C2").Value
        fdate = .Range("C3").Value
        For i = 1 To UBound(arr, 1)
            If CLng(arr(i, 2)) < CLng(edate) Then
               dk = arr(i, 3)
               If dic.exists(dk) = 0 Then
                  If UCase(arr(i, 7)) = UCase("input") Then
                      dic.Item(dk) = Array(arr(i, 5))
                  Else
                      dic.Item(dk) = Array(-arr(i, 5))
                  End If
               Else
                  b = dic.Item(dk)(0)
                  If UCase(arr(i, 7)) = UCase("input") Then
                      b = b + arr(i, 5)
                  Else
                     b = b - arr(i, 5)
                  End If
                  dic.Item(dk) = Array(b)
               End If
           End If
        Next i
        For i = 1 To UBound(arr, 1)
           If CLng(arr(i, 2)) >= CLng(edate) And CLng(arr(i, 2)) <= CLng(fdate) Then
               dk = arr(i, 3)
               dks = arr(i, 2) & arr(i, 3)
                If dic.exists(dk) Then
                       If dic.exists(dks) = 0 Then
                             a = a + 1
                             arr1(a, 1) = a
                             arr1(a, 2) = arr(i, 2)
                             arr1(a, 3) = arr(i, 3)
                             arr1(a, 4) = dic.Item(dk)(0)
                          If UCase(arr(i, 7)) = UCase("input") Then arr1(a, 5) = arr(i, 5) Else arr1(a, 6) = arr(i, 5)
                             arr1(a, 7) = arr1(a, 4) + arr1(a, 5) - arr1(a, 6)
                             dic.Item(dks) = Array(a)
                             dic.Item(dk) = Array(arr1(a, 7))
                        Else
                            d = dic.Item(dks)(0)
                           If UCase(arr(i, 7)) = UCase("input") Then arr1(d, 5) = arr1(d, 5) + arr(i, 5) Else arr1(d, 6) = arr1(d, 6) + arr(i, 5)
                             arr1(d, 7) = arr1(d, 4) + arr1(d, 5) - arr1(d, 6)
                             dic.Item(dk) = Array(arr1(d, 7))
                        End If
               Else
                        If dic.exists(dks) = 0 Then
                             a = a + 1
                             arr1(a, 1) = a
                             arr1(a, 2) = arr(i, 2)
                             arr1(a, 3) = arr(i, 3)
                             arr1(a, 4) = Empty
                          If UCase(arr(i, 7)) = UCase("input") Then arr1(a, 5) = arr(i, 5) Else arr1(a, 6) = arr(i, 5)
                             arr1(a, 7) = arr1(a, 4) + arr1(a, 5) - arr1(a, 6)
                             dic.Item(dks) = Array(a)
                             dic.Item(dk) = Array(arr1(a, 7))
                        Else
                            d = dic.Item(dks)(0)
                            If UCase(arr(i, 7)) = UCase("input") Then arr1(d, 5) = arr1(d, 5) + arr(i, 5) Else arr1(d, 6) = arr1(d, 6) + arr(i, 5)
                             arr1(d, 7) = arr1(d, 4) + arr1(d, 5) - arr1(d, 6)
                             dic.Item(dk) = Array(arr1(d, 7))
                        End If
                End If
            End If
        Next i
       c = .Range("P" & Rows.Count).End(xlUp).Row
       If c > 7 Then .Range("P7:P" & c).Resize(, 7).ClearContents
       If a Then .Range("p7").Resize(a, 7).Value = arr1
End With


End Sub
Nhấp chuột vào đây để mở rộng...

Anh ơi, code chạy tuyệt vời, nhưng sao file vẫn chậm lắm ạ, em chờ sốt cả ruột đợi mãi nó load xong ạ, không biết có phải do lỗi của mấy chỗ trong file không anh? anh xem file và giúp em với ạ
 

File đính kèm

Upvote 0
hoangtuaotrang_hp_vn đã viết:
Anh ơi, code chạy tuyệt vời, nhưng sao file vẫn chậm lắm ạ, em chờ sốt cả ruột đợi mãi nó load xong ạ, không biết có phải do lỗi của mấy chỗ trong file không anh? anh xem file và giúp em với ạ
Nhấp chuột vào đây để mở rộng...
File của bạn nhiều công thức quá.Bạn tắt chế độ Automatic đi rồi chạy code là nhanh mà.
 
Lần chỉnh sửa cuối:
Upvote 0
hoangtuaotrang_hp_vn đã viết:
Dạ, cháu muốn 2 sheet sau sẽ được lọc tự động ấy chú :
1. Input-Output-Inventory (sheet này: cột B và C đáng ra phải được lọc tự động-bỏ trùng, nhưng vì cháu không biết xử lý nên mới copy bằng tay từ sheet In-Out Daily sang ạ)
2. Lookup

tính đến thời điểm này thì công thức vẫn chính xác chú à :D

Có gì chú giúp cháu với, nhiều cái cháu chưa biết chú chỉ thêm cho cháu với ạ :)
Nhấp chuột vào đây để mở rộng...
Cái nào không liên quan bỏ qua.
Sheet nào không liên quan bỏ qua.
Dữ liệu của bạn không nên dùng công thức, khủng khiếp quá, tính toán quá chậm.
 

File đính kèm

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

N
Thử viết code lập trình đa luồng bằng TwinBasic và khả năng ứng dụng vào COM add-in chạy trong Excel
    • Thích
Trả lời
1
Đọc
229
nguyendang95
N
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
14 15 16
Trả lời
312
Đọc
23K
tavanluu
T
A
Kính nhờ xử lý nhập công thức hàm IF kết hợp nhiều điều kiện
Trả lời
1
Đọc
27
thuytrangbp28
T
Momominh
Hỏi công thức tìm kiếm
Trả lời
2
Đọc
25
thuytrangbp28
T
huongmuine
Điền số thứ tự theo nhóm có điều kiện
Trả lời
4
Đọc
50
huongmuine
huongmuine
Mewwo98
Thay dấu ngăn cách sau chữ số hàng nghìn, hàng triệu, hàng tỷ trong Mail Merge
Trả lời
12
Đọc
221
HeSanbi
HeSanbi
K
  • Question Question
BÀI TOÁN TÌM GIÁ USD VÀ TÌM LƯỢNG KG - NHỜ ANH/CHỊ GIÚP ĐỠ
    • Chấp nhận
Trả lời
3
Đọc
44
VetMini
V
H
Nhờ các bạn mở quá công thức của các sheet
Trả lời
3
Đọc
60
VetMini
V
Y
Không copy được dữ liệu sang sheet khac
Trả lời
12
Đọc
24K
leduchien1001
L
S
Lỗi Path/File access error:'.\VBFB.tmp'
Trả lời
10
Đọc
4K
dhtq159
D
N
Vẽ đường tròn bám theo 1 Polyline
Trả lời
4
Đọc
62
nguyenvanvien
N
T
Bảng tính trợ cấp theo Nghị định 178 và tính lương hưu
    • Thích
Trả lời
3
Đọc
145
trung_bhxh
T
GPE-Trợ Lý
KHÓA HỌC BỨT PHÁ KỸ NĂNG EXCEL
    • Thích
    • Yêu thích
Trả lời
4
Đọc
1K
GPE-Trợ Lý
GPE-Trợ Lý
OverAC
TPHCM - Gặp mặt đầu năm Ất Tỵ 18g ngày 8/2
    • Thích
    • Ngạc nhiên
Trả lời
1
Đọc
94
tungnguyen_kt
tungnguyen_kt
ptm0412
  • Question Question
Cách lấy link file excel nguồn cho Power query từ Onedrive, Google drive
    • Thích
    • Yêu thích
Trả lời
7
Đọc
3K
pxhieu1993
P
Y
Nhờ các anh chị xem giúp Hàm Sumproduct
Trả lời
0
Đọc
38
yoomi
Y
dinhnhat91
  • Question Question
VBA Lỗi runtime error 9 subscript out of range
Trả lời
4
Đọc
109
ongke0711
ongke0711
GPE-Trợ Lý
[GPE] TALK SHOW EXCEL TRONG SẢN XUẤT
    • Thích
Trả lời
1
Đọc
573
PhanTuHuong
PhanTuHuong
Việt Nguyễn 86
Excel hay bị tắt đột ngột và hiện trang trắng khi làm việc
Trả lời
0
Đọc
66
Việt Nguyễn 86
Việt Nguyễn 86
K
Mong giúp dữ liệu từ trang web sang excel
Trả lời
0
Đọc
66
khanhvinhdai1
K
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới Ất Tỵ 2025
Back
Top Bottom