Tính giá xuất kho bằng VBA (1 người xem)

canguocs · 5/11/15

Chào anh chị và các bạn. Mình có file đính kèm, cần tính cột I và J trong sheet NX. Cột I là giá bình quân, cột J là giá trị xuất.
Hai cột K và L chỉ là minh họa cách tính để cho mọi người hiểu (không cần tính hai cột này).
Giá bình quân = Tồn lần cuối thành tiền trước khi xuất / Tồn lần cuối số lượng trước khi xuất
Tồn thành tiền = Tồn đầu kỳ thành tiền(nếu có)+ cộng dồn thành tiền nhập trong kỳ- cộng dồn thành tiền xuất
Tồn số lượng cũng tương tự như vậy
Mình có ý tưởng nhưng đang gặp trục trặc trong quá trình thực hiện, chi tiết mọi người xem file đính kèm.
Nhờ sự trợ giúp của tất cả các bạn. Xin cảm ơn

Mã:

Sub Gia_Tong()
Dim Arr, Kq, i&, j&, k&, Tem As String, Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")

Arr = Sheets("Ma").Range("A7:D" & Sheets("Ma").[D1000].End(3).Row)

ReDim Kq(1 To UBound(Arr, 1), 1 To 9)
For i = 1 To UBound(Arr, 1)
    Tem = Arr(i, 1)
    If Not Dic.exists(Tem) Then
     k = k + 1
     Dic.Add Tem, k
     Kq(k, 1) = Arr(i, 3)
     Kq(k, 2) = Arr(i, 4)
      
    End If
Next i

Arr = Sheets("NX").Range("C9:J" & Sheets("NX").[C1000].End(3).Row)

For i = 1 To UBound(Arr, 1)
        Tem = Arr(i, 1)
        If Dic.exists(Tem) Then
            Kq(Dic.Item(Tem), 1) = Kq(Dic.Item(Tem), 1) + Arr(i, 4) - Arr(i, 6) 'Cong don so luong
        
           Kq(Dic.Item(Tem), 2) = Kq(Dic.Item(Tem), 2) + Arr(i, 5) - Arr(i, 8) ' Cong don thanh tien
        End If
        'If Sarr(i, 6) > 0 Then ' Neu so luong xuat lon hon 0 thi tinh don gia xuat
            Kq(Dic.Item(Tem), 3) = Kq(Dic.Item(Tem), 2) / Kq(Dic.Item(Tem), 1) ' Don gia binh quan
       ' End If
        Kq(k, 4) = Arr(i, 6) * Kq(k, 3) ' Thanh tien xuat
Next i
Sheets("NX").[I9].Resize(k) = Kq(i, 3)
Sheets("NX").[J9].Resize(k) = Kq(i, 4)
End Sub

canguocs · 5/11/15

Nếu giữa dòng 8 và dòng 9 thêm một dòng trắng thì công thức sau vẫn nhận, nhưng dữ liệu của mình ít nhất hơn 20.000 dòng nên muốn dùng VBA cho nhẹ

Mã:

=IF(H10=0,0,((SUMIF(Ma!$A$7:$A$19,NX!C10,Ma!$D$7:$D$19)+SUMIF(NX!$C$9:C9,NX!C10,NX!$G$9:G9)-SUMIF(NX!$C$9:C9,NX!C10,NX!$J$9:J9))/(SUMIF(Ma!$A$7:$A$19,NX!C10,Ma!$C$7:$C$19)+SUMIF(NX!$C$9:C9,NX!C10,NX!$F$9:F9)-SUMIF(NX!$C$9:C9,NX!C10,NX!$H$9:H9))))

Ba Tê · 6/11/15

canguocs đã viết:
Chào anh chị và các bạn. Mình có file đính kèm, cần tính cột I và J trong sheet NX. Cột I là giá bình quân, cột J là giá trị xuất.
Hai cột K và L chỉ là minh họa cách tính để cho mọi người hiểu (không cần tính hai cột này).
Giá bình quân = Tồn lần cuối thành tiền trước khi xuất / Tồn lần cuối số lượng trước khi xuất
Tồn thành tiền = Tồn đầu kỳ thành tiền(nếu có)+ cộng dồn thành tiền nhập trong kỳ- cộng dồn thành tiền xuất
Tồn số lượng cũng tương tự như vậy
Mình có ý tưởng nhưng đang gặp trục trặc trong quá trình thực hiện, chi tiết mọi người xem file đính kèm.
Nhờ sự trợ giúp của tất cả các bạn. Xin cảm ơn

Làm thí thí theo kết quả mẫu, hên xui chứ không hiểu lắm.

canguocs · 6/11/15

Ba Tê đã viết:
Làm thí thí theo kết quả mẫu, hên xui chứ không hiểu lắm.

Mã:

MH trong cột C không có bên sheet Ma nên không tính.

Chính câu này cũng là cái em đang bí, với những mặt hàng không có trong tồn đầu ký , nghĩa là phát sinh nhập mã hàng hoàn toàn mới, thì giá vốn cũng được tính tương tự : Tồn thành tiền/ tồn số lượng
ví dụ mã hàng: CC-00012, mã hàng mới hoàn toàn. Khi nhập 15 với số tiền là 45
Bây giờ ngày tiếp theo xuât, giá xuất = 45/15
Ví dụ 2: mã hàng: CC-00012, mã hàng mới hoàn toàn. Khi nhập 15 với số tiền là 45
ngày tiếp theo nhập số lượng 5 với thành tiền = 10
Bây giờ tổng thành tiền là 45+10=55
bây giờ tổng số lượng là : 15+5 = 20
Nếu bây giờ xuất 2, thì giá xuất bình quân = 55/20 và giá trị xuất = 2*(55/20)
Với những mã hàng cũ, cách của Thầy hoàn toàn đúng rồi ah.
Nhờ Thầy và các bạn giúp đỡ ah.

Ba Tê · 6/11/15

canguocs đã viết:
Mã:

MH trong cột C không có bên sheet Ma nên không tính.

Chính câu này cũng là cái em đang bí, với những mặt hàng không có trong tồn đầu ký , nghĩa là phát sinh nhập mã hàng hoàn toàn mới, thì giá vốn cũng được tính tương tự : Tồn thành tiền/ tồn số lượng
ví dụ mã hàng: CC-00012, mã hàng mới hoàn toàn. Khi nhập 15 với số tiền là 45
Bây giờ ngày tiếp theo xuât, giá xuất = 45/15
Ví dụ 2: mã hàng: CC-00012, mã hàng mới hoàn toàn. Khi nhập 15 với số tiền là 45
ngày tiếp theo nhập số lượng 5 với thành tiền = 10
Bây giờ tổng thành tiền là 45+10=55
bây giờ tổng số lượng là : 15+5 = 20
Nếu bây giờ xuất 2, thì giá xuất bình quân = 55/20 và giá trị xuất = 2*(55/20)
Với những mã hàng cũ, cách của Thầy hoàn toàn đúng rồi ah.
Nhờ Thầy và các bạn giúp đỡ ah.

Thì sang sheet Ma, nhập mã hàng mới chưa có vào.
Nếu phát sinh chuyện gì làm dữ liệu không chuẩn thì nên "chuẩn hóa" cho nó, sau này khỏi "bí".

canguocs · 6/11/15

Ba Tê đã viết:
Thì sang sheet Ma, nhập mã hàng mới chưa có vào.
Nếu phát sinh chuyện gì làm dữ liệu không chuẩn thì nên "chuẩn hóa" cho nó, sau này khỏi "bí".

Em thêm nó báo lỗi đoạn này
tArr(I, 5) = tArr(I, 4) / tArr(I, 3), chăc là lỗi chia #DIV/0
Em cho đoạn này vào
On Error Resume Next, thì tốt rồi ah.
Thêm mã vào Sheet Mã là được, mà em ko nghĩ ra, lúc đầu cách cũ của em cũng được mã cũ rồi nhưng mã mới không thêm vào sheet mã nên hổng được
Em vừa thử cách cũ (thêm mã mới vào sheet Ma) ra luôn nhưng hơi rườm ra, cách làm của Thầy quá hay luôn.
Chân thành cảm ơn Thầy nhiều ah.

Ba Tê · 6/11/15

canguocs đã viết:
Em thêm nó báo lỗi đoạn này
tArr(I, 5) = tArr(I, 4) / tArr(I, 3), chăc là lỗi chia #DIV/0
Em cho đoạn này vào
On Error Resume Next, thì tốt rồi ah.
Thêm mã vào Sheet Mã là được, mà em ko nghĩ ra, lúc đầu cách cũ của em cũng được mã cũ rồi nhưng mã mới không thêm vào sheet mã nên hổng được
Em vừa thử cách cũ (thêm mã mới vào sheet Ma) ra luôn nhưng hơi rườm ra, cách làm của Thầy quá hay luôn.
Chân thành cảm ơn Thầy nhiều ah.

Viết code mà có dòng On Error Resume Next thì chưa "đã".
Thử thay bằng cái này, Nếu mã mới chưa có, nó điền thêm vào Côt MH sheet Ma luôn. Khỏi tìm từng mã mới mà thêm.

PHP:

Public Sub NXGPE()
Dim Dic As Object, sArr(), dArr(), tArr(), I As Long, J As Long, K As Long, Rws As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Ma")
    sArr = .Range(.[A7], .[A7].End(xlDown)).Resize(, 4).Value
End With
ReDim tArr(1 To 100, 1 To 5) '<----------Du lieu sheet Ma toi da 100 MH'
For I = 1 To UBound(sArr, 1)
    If sArr(I, 1) <> Empty Then
        Tem = sArr(I, 1)
        K = K + 1
        If Not Dic.Exists(Tem) Then
            Dic.Add sArr(I, 1), K
            For J = 1 To 4
                tArr(K, J) = sArr(I, J)
            Next J
            If sArr(I, 3) > 0 Then tArr(K, 5) = sArr(I, 4) / sArr(I, 3)
        End If
    End If
Next I
With Sheets("NX_GPE")
    sArr = .Range(.[C9], .[C9].End(xlDown)).Resize(, 6).Value
    ReDim dArr(1 To UBound(sArr, 1), 1 To 4)
    For I = 1 To UBound(sArr, 1)
        Tem = sArr(I, 1)
        If Not Dic.Exists(Tem) Then
                K = K + 1
                Dic.Add Tem, K
                tArr(K, 1) = sArr(I, 1)
                tArr(K, 3) = sArr(I, 4)
                tArr(K, 4) = sArr(I, 5)
                If sArr(I, 4) > 0 Then tArr(K, 5) = sArr(I, 5) / sArr(I, 4)
        Else
            Rws = Dic.Item(Tem)
            If sArr(I, 4) <> Empty Then
                tArr(Rws, 3) = tArr(Rws, 3) + sArr(I, 4)
                tArr(Rws, 4) = tArr(Rws, 4) + sArr(I, 5)
                tArr(Rws, 5) = tArr(Rws, 4) / tArr(Rws, 3)
            End If
            If sArr(I, 6) <> Empty Then
                dArr(I, 1) = tArr(Rws, 5)
                dArr(I, 2) = tArr(Rws, 5) * sArr(I, 6)
                tArr(Rws, 3) = tArr(Rws, 3) - sArr(I, 6)
            End If
            dArr(I, 3) = tArr(Rws, 3)
            dArr(I, 4) = tArr(Rws, 3) * tArr(Rws, 5)
        End If
    Next I
    .[I9].Resize(I - 1, 2) = dArr
End With
Sheets("Ma").[A7].Resize(K) = tArr
Set Dic = Nothing
End Sub

canguocs · 6/11/15

Ba Tê đã viết:

Viết code mà có dòng On Error Resume Next thì chưa "đã".
Thử thay bằng cái này, Nếu mã mới chưa có, nó điền thêm vào Côt MH sheet Ma luôn. Khỏi tìm từng mã mới mà thêm.

PHP:

Public Sub NXGPE()
Dim Dic As Object, sArr(), dArr(), tArr(), I As Long, J As Long, K As Long, Rws As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Ma")
    sArr = .Range(.[A7], .[A7].End(xlDown)).Resize(, 4).Value
End With
ReDim tArr(1 To 100, 1 To 5) '<----------Du lieu sheet Ma toi da 100 MH'
For I = 1 To UBound(sArr, 1)
    If sArr(I, 1) <> Empty Then
        Tem = sArr(I, 1)
        K = K + 1
        If Not Dic.Exists(Tem) Then
            Dic.Add sArr(I, 1), K
            For J = 1 To 4
                tArr(K, J) = sArr(I, J)
            Next J
            If sArr(I, 3) > 0 Then tArr(K, 5) = sArr(I, 4) / sArr(I, 3)
        End If
    End If
Next I
With Sheets("NX_GPE")
    sArr = .Range(.[C9], .[C9].End(xlDown)).Resize(, 6).Value
    ReDim dArr(1 To UBound(sArr, 1), 1 To 4)
    For I = 1 To UBound(sArr, 1)
        Tem = sArr(I, 1)
        If Not Dic.Exists(Tem) Then
                K = K + 1
                Dic.Add Tem, K
                tArr(K, 1) = sArr(I, 1)
                tArr(K, 3) = sArr(I, 4)
                tArr(K, 4) = sArr(I, 5)
                If sArr(I, 4) > 0 Then tArr(K, 5) = sArr(I, 5) / sArr(I, 4)
        Else
            Rws = Dic.Item(Tem)
            If sArr(I, 4) <> Empty Then
                tArr(Rws, 3) = tArr(Rws, 3) + sArr(I, 4)
                tArr(Rws, 4) = tArr(Rws, 4) + sArr(I, 5)
                tArr(Rws, 5) = tArr(Rws, 4) / tArr(Rws, 3)
            End If
            If sArr(I, 6) <> Empty Then
                dArr(I, 1) = tArr(Rws, 5)
                dArr(I, 2) = tArr(Rws, 5) * sArr(I, 6)
                tArr(Rws, 3) = tArr(Rws, 3) - sArr(I, 6)
            End If
            dArr(I, 3) = tArr(Rws, 3)
            dArr(I, 4) = tArr(Rws, 3) * tArr(Rws, 5)
        End If
    Next I
    .[I9].Resize(I - 1, 2) = dArr
End With
Sheets("Ma").[A7].Resize(K) = tArr
Set Dic = Nothing
End Sub

Phát sinh một chút Thầy ah, ở I 12 phải bằng 8.500, em gửi File Đính kèm ah

Mã:

 If sArr(I, 6) <> Empty Then
                dArr(I, 1) = tArr(Rws, 5)
                dArr(I, 2) = tArr(Rws, 5) * sArr(I, 6)
                tArr(Rws, 3) = tArr(Rws, 3) - sArr(I, 6)
              [B]  tArr(Rws, 4) = tArr(Rws, 4) - sArr(I, 8)[/B]

Ở dòng cuối cùng , em nghĩ nếu đã trừ số lượng, chắc phải trừ thành tiền đúng không ah?

canguocs · 6/11/15

Ở code mới thêm dòng này

Mã:

tArr(Rws, 4) = tArr(Rws, 4) - sArr(I, 8)

thì báo lỗi over load

Mã:

tArr(Rws, 5) = tArr(Rws, 4) / tArr(Rws, 3)

Nhưng nếu có on error vào, ra đúng I12 bằng 8500 (ấn 2 lần vào GPE là ra được 8.500 và giá xuất đúng của tất cả các mặt hàng, em chưa hiểu tại sao) Thầy ah.
Thêm On vào cũng được Thầy ah, em đang test các trường hợp, thấy chạy mượt rồi ah
Cảm ơn Thầy nhiều ah

canguocs · 6/11/15

Do lúc trước em chưa mở rộng vùng nên báo Over, giờ mở lại vùng không cần On ERROR nữa rồi ah, bấm 2 lần vào GPE là được.
Code ban đầu của em cũng ngon lành rồi ah, test hai bản giống nhau. Chắc hổng phải bảo hành lần sau đâu ah.

Mã:

If sArr(I, 6) <> Empty Then
                dArr(I, 1) = tArr(Rws, 5)
                dArr(I, 2) = tArr(Rws, 5) * sArr(I, 6)
                tArr(Rws, 3) = tArr(Rws, 3) - sArr(I, 6)
                tArr(Rws, 4) = tArr(Rws, 4) - sArr(I, 8)
            End If
            dArr(I, 3) = tArr(Rws, 3)
            dArr(I, 4) = tArr(Rws, 4)

Đoạn cuối này sửa thế này, chạy quá ổn luôn ah, mặc dù em không cần I3 và I4, cảm ơn Thầy một lần nữa ah.

Ba Tê · 7/11/15

canguocs đã viết:
Do lúc trước em chưa mở rộng vùng nên báo Over, giờ mở lại vùng không cần On ERROR nữa rồi ah, bấm 2 lần vào GPE là được.
Code ban đầu của em cũng ngon lành rồi ah, test hai bản giống nhau. Chắc hổng phải bảo hành lần sau đâu ah.

Mã:

If sArr(I, 6) <> Empty Then dArr(I, 1) = tArr(Rws, 5) dArr(I, 2) = tArr(Rws, 5) * sArr(I, 6) tArr(Rws, 3) = tArr(Rws, 3) - sArr(I, 6) tArr(Rws, 4) = tArr(Rws, 4) - sArr(I, 8) End If dArr(I, 3) = tArr(Rws, 3) dArr(I, 4) = tArr(Rws, 4)

Đoạn cuối này sửa thế này, chạy quá ổn luôn ah, mặc dù em không cần I3 và I4, cảm ơn Thầy một lần nữa ah.

Chẳng biết bạn "mở rộng" là mở ra sao, vùng dữ liệu mảng sArr() chí có 6 cột, bạn lại sử dụng sArr(I,8)?
Code chạy đúng thì chỉ bấm nút 1 lần là ra kết quả, sao lại bấm 2 lần?
Chưa rõ lắm cái chuyện tính toán này nên "cố hiểu", làm theo kiểu lòng vòng thôi. Nếu nắm vững Nguyên tắc của nó thì có lẽ code sẽ ngắn gọn hơn.
Xem thử lại file này:
Kết quả 3 cột K,L,M là để kiểm tra, nếu không cần thì sửa dòng này:
.[I9].Resize(I - 1, 5) = dArr thành .[I9].Resize(I - 1, 2) = dArr

canguocs · 7/11/15

Ba Tê đã viết:
Chẳng biết bạn "mở rộng" là mở ra sao, vùng dữ liệu mảng sArr() chí có 6 cột, bạn lại sử dụng sArr(I,8)?
Code chạy đúng thì chỉ bấm nút 1 lần là ra kết quả, sao lại bấm 2 lần?
Chưa rõ lắm cái chuyện tính toán này nên "cố hiểu", làm theo kiểu lòng vòng thôi. Nếu nắm vững Nguyên tắc của nó thì có lẽ code sẽ ngắn gọn hơn.
Xem thử lại file này:
Kết quả 3 cột K,L,M là để kiểm tra, nếu không cần thì sửa dòng này:
.[I9].Resize(I - 1, 5) = dArr thành .[I9].Resize(I - 1, 2) = dArr

Lần đầu em chạy chỉ cần bấm 1 lần, sau em xóa thử đơn giá cũ, thấy bấm 2 lần mới ra. Không biết máy em có vấn đề không (Em test hơi nhiều, chắc bị tẩu hỏa nhập ma). Hôm nay thử lại file này thì ngon lành rồi ah, bấm 1 lần ra luôn, em mở đến I8 là vì em định lấy luôn tồn số lượng, và tồn thành tiền cuối kỳ như file mới của thầy nên em thêm 2 cột nữa
Nếu không thì

Mã:

tArr(Rws, 4) = tArr(Rws, 4) - dArr(I, 2)

là được rồi ah

Mã:

.[I9].Resize(I - 1, 5) = dArr thành .[I9].Resize(I - 1, 2) = dArr

Đoạn này em tự mở rộng thêm rồi ah.

Mã:

Chưa rõ lắm cái chuyện tính toán này nên "cố hiểu", làm theo kiểu lòng vòng thôi.

Đoạn này tuy hơi lòng vòng nhưng em thấy cứ làm kiểu bắc cầu cũng thấy dễ làm. Nói chung, Thầy hiểu được trong file đính kèm là tuyện vời rồi ah. Cảm ơn Thầy nhiều.

Tính giá xuất kho bằng VBA (1 người xem)

Người dùng đang xem chủ đề này

canguocs

Thành viên hoạt động

File đính kèm

canguocs

Thành viên hoạt động

Ba Tê

Cạo Rồi Khỏi Gội

File đính kèm

canguocs

Thành viên hoạt động

Ba Tê

Cạo Rồi Khỏi Gội

canguocs

Thành viên hoạt động

Ba Tê

Cạo Rồi Khỏi Gội

canguocs

Thành viên hoạt động

File đính kèm

canguocs

Thành viên hoạt động

canguocs

Thành viên hoạt động

Ba Tê

Cạo Rồi Khỏi Gội

File đính kèm

canguocs

Thành viên hoạt động

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

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