Code tính Nhập - Xuất - Tồn cuối (1 người xem)

[NguyenthiH]

Chào mọi người!
Em có file này, mong mọi người giúp em viết code để tính Nhập-Xuất-Tồn cuối.
Trong file em nhờ mọi người viết code Sub WorkSheet_Active() trong sheet"Ton" để khi sheet"Ton" Active thì nạp dữ liệu không trùng vào Sheet"Ton"("B2") và tính Nhập Xuất Tồn cuối theo nhà cung cấp và hàng hóa của nhà cung cấp đó. Tồn cuối = Nhập - Xuất.
Em Cám ơn mọi người.

 

[Ba Tê]

Chào mọi người!
Em có file này, mong mọi người giúp em viết code để tính Nhập-Xuất-Tồn cuối.
Trong file em nhờ mọi người viết code Sub WorkSheet_Active() trong sheet"Ton" để khi sheet"Ton" Active thì nạp dữ liệu không trùng vào Sheet"Ton"("B2") và tính Nhập Xuất Tồn cuối theo nhà cung cấp và hàng hóa của nhà cung cấp đó. Tồn cuối = Nhập - Xuất.
Em Cám ơn mọi người.

Không có Nhập thì đừng có Xuất nhé.

Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), I As Long, K As Long, R As Long, Rws As Long, Tmp As String
Set Dic = CreateObject("Scripting.Dictionary")
'------------------------------------------------------Nhap'
With Sheets("Nhap")
    sArr = .Range("B2", .Range("B2").End(xlDown)).Resize(, 4).Value
    R = UBound(sArr)
    ReDim dArr(1 To R, 1 To 7)
End With
For I = 1 To R
    Tmp = sArr(I, 1) & "#" & sArr(I, 2) & "$" & sArr(I, 3)
    If Not Dic.Exists(Tmp) Then
        K = K + 1: Dic.Add Tmp, K
        dArr(K, 1) = K: dArr(K, 2) = sArr(I, 1)
        dArr(K, 3) = sArr(I, 2): dArr(K, 4) = sArr(I, 3): dArr(K, 5) = sArr(I, 4)
    Else
        Rws = Dic.Item(Tmp)
        dArr(Rws, 5) = dArr(Rws, 5) + sArr(I, 4)
    End If
Next I
'------------------------------------------------------Xuat'
With Sheets("Xuat")
    sArr = .Range("B2", .Range("B2").End(xlDown)).Resize(, 4).Value
    R = UBound(sArr)
End With
For I = 1 To R
    Tmp = sArr(I, 1) & "#" & sArr(I, 2) & "$" & sArr(I, 3)
    If Dic.Exists(Tmp) Then
        Rws = Dic.Item(Tmp)
        dArr(Rws, 6) = dArr(Rws, 6) + sArr(I, 4)
    End If
Next I
'-------------------------------------------------Ton'
For I = 1 To K
    dArr(I, 7) = dArr(I, 5) - dArr(I, 6)
Next I
'--------------------------------------------------OK'
With Sheets("Ton")
    .Range("A2:G1000").ClearContents
    .Range("A2:G2").Resize(K) = dArr
End With
Set Dic = Nothing
End Sub

 

[NguyenthiH]

Cám Ơn Thầy Ba Tê nhiều!
Thầy có thể định dạng ("#.##0.00") cho các cột "Nhập" "Xuất" "Tồn Cuối" dùm em ah.
Và nếu không có Xuất thì là ("0.00")
và Border cho dữ liệu.
Mong Thầy giúp.

 

[Ba Tê]

Cám Ơn Thầy Ba Tê nhiều!
Thầy có thể định dạng ("#.##0.00") cho các cột "Nhập" "Xuất" "Tồn Cuối" dùm em ah.
Và nếu không có Xuất thì là ("0.00")
và Border cho dữ liệu.
Mong Thầy giúp.

1/ Định dạng thì bạn làm thủ công 1 lần đầu cho các cột, code chỉ gán dữ liệu đâu có động chạm gì đến Format.
(Mỗi lần chạy code "mắc" Format lại, máy tôi nó không chịu chạy. Híc!)
2/ Không có xuất thì gán 0: Bạn tìm chỗ này và chỉnh cho giống vầy:
(Đoạn Nhập)

If Not Dic.Exists(Tmp) Then
        K = K + 1: Dic.Add Tmp, K
        dArr(K, 1) = K: dArr(K, 2) = sArr(I, 1): dArr(K, 3) = sArr(I, 2)
        dArr(K, 4) = sArr(I, 3): dArr(K, 5) = sArr(I, 4): dArr(K, 6) = 0
    Else

3/ Border: Trong đoạn cuối chỉnh lại thành như vầy:

With Sheets("Ton")
    .Range("A2:G1000").ClearContents
    .Range("A2:G2").Resize(K) = dArr
    .Range("A2:G2").Resize(K).Borders.LineStyle = 1
End With

 

[NguyenthiH]

Cám Ơn Thầy Ba Tê!
Đoạn code nào mà rải số thứ tự tự động vậy Thầy?

 

[phulien1902]

Trong khi thầy còn đang nghiên cứu giải bài cho người khác thì tôi trả lời giúp bạn, đó là dòng:

dArr(K, 1) = K

 

[NguyenthiH]

Cám Ơn bạn phulien1902!
Mình ngâm cứu code hoài mà không biết tự viết được đoạn code nào.

 

[phulien1902]

Cám Ơn bạn phulien1902!
Mình ngâm cứu code hoài mà không biết tự viết được đoạn code nào.

Bạn à, không ai tự sinh ra đã giỏi ngay được, phải có một quá trình rèn luyện, nghiên cứu, tìm tòi mới ngộ ra được những vấn đề khó hiểu.
Cũng như tôi, cũng đọc khá nhiều tài liệu, nhưng đã biết gì đâu. Vậy nên bạn cũng chớ có buồn làm gì?
Con chim muốn bay cao, bay xa được, nó phải tập bay từ cành này sang cành khác, từng bước, từng bước 1....

 

[Gió Đông]

Cám Ơn bạn phulien1902!
Mình ngâm cứu code hoài mà không biết tự viết được đoạn code nào.

Muốn ngâm cứu, thì phải đi từ bài đơn giản
+ Helloworld
+ Cộng 2 số
+ ....

Còn chưa tập đi bộ đường dài, mà đã lên leo núi ngay thì sao leo được ...

 

[NguyenthiH]

Em có copy code sort của Anh Hiếu vào mà sao cột STT của sheet "Ton" không đúng, mong mọi người giúp ah.

With Sheets("Ton")
    .Range("A2:G1000").ClearContents
    .Range("A2:G2").Resize(K) = dArr
    .Range("A2:G2").Resize(K).Borders.LineStyle = 1
   [SIZE=3][B][COLOR=#ff0000] .Range("A2:G2").Resize(K).Sort [C2], 1, [G2], , 2, Header:=xlYes[/COLOR][/B][/SIZE]
End With

nhưng sao không còn rải số thứ tự từ nhỏ đến lơn nữa.( 1,2,3,4,5,6,7..v.v.vv)

 

[Gió Đông]

Thử đổi
.Range("A2:G2").Resize(K).Sort [B3], 1, [F3], , 1, Header:=xlYes

thành

.Range("B2:G2").Resize(K).Sort [B3], 1, [F3], , 1, Header:=xlYes

 

[NguyenthiH]

Oh!!!
Được rồi bạn ơi!
Cám ơn Bạn.