1/ Cơ sở nào có số tồn đầu ngày 01/01Chào các bạn mong các bạn trợ giúp, mình có 1 file gồm 3 sheets:
- Sheet PHATSINH chứa các số liệu nhập - xuất kho
- Sheet KHO A là để báo cáo nhập xuất tồn của kho A
- Sheet KHO A là để báo cáo nhập xuất tồn của kho B
Cả hai kho này đều dựa vào CSDL của sheet PHATSINH để lọc lấy số liệu.
Mong các bạn giúp đỡ. Thanks
Cám ơn bác, 1/ Tồn đầu kỳ 01/01 là dựa vào báo cáo NXT cuối năm trước, mình copy sang 2/ Số tiền Phatsinh là giá vốn mình mua vào hoặc bán ra 3/ Mã HH là 156101 ... 4/ Chính xác. đơn giá trong BC NXT là giá BQ Mình rất thích dùng VBA, nhưng đối với BC NXT thì thích dùng CT hơn cho dễ hiểu. Thanks
Bác ThuNghi chạy đâu mất rồi, giúp với. Chắc chạy Sô rồi!
Thú thật dùng công cho file này thì dùng sumproduct hay là sumif có thêm cột phụ hay là sumifs với ex 2007, nhưng tất cả đều chạy chậm. Và lâu rồi nên cũng quên ct, dùng VBA mà lấy số tồn từ ngày -> ngày còn muốn mệt nữa.
Ok. Bác làm giúp. Thanks
Có tạo thêm 1 sh TonDau của 01/01/2011.
Cám ơn bác. Khi xuất chuyển hàng từ kho A --> kho B: VD N156101 C156101 với Slg là 5 chẳng hạn; cột KHO có ký hiệu là B/A và ngược lại xuất chuyển hàng từ kho B --> kho A cột KHO có ký hiệu là B/A thì làm sao hả bác, giúp với. Nhìn rừng code thấy sợ quá!
Chuyện nhỏ mà, trước mắt làm 2 phiếu, PN và PX và nghiên cứu code đã.
Theo tôi bạn nên tổ chức file như sau:
Thấy báo cáo của bạn cũng hơi lạ, chưa nắm hết, hình như tao BC NXT theo số PN và tên hàng.
Bạn thêm khoảng 10 cột nên code sẽ chạy sai thôi.
Cám ơn bạn.
File nặng do phần format màu mè nên hơi nặng. Dòng nhập tô màu vàng và dùng Conditional Format.
Hiện tại sh NXT trên đang sỏt theo TT sau
Bạn mở code và sửa lại phần sort thử xem.
'sort
With myRng
.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Key2:=.Cells(1, 4 _
), Order2:=xlAscending, Key3:=.Cells(1, 2), Order3:=xlAscending, Header _
:=xlYes
End With'sort
With myRng
.Sort Key1:=.Cells(1, 2), Order1:=xlAscending, Key2:=.Cells(1, 1 _
), Order2:=xlAscending, Key3:=.Cells(1, 4), Order3:=xlAscending, Header _
:=xlYes
End WithTôi sửa code lại 1 chút về format và sort theo ngày.
Sub TaoBC()
Dim endR&, i&, s&, k&
Dim ArrNh(), ArrXh1(), ArrXh2(), ArrData()
Dim myRng As Range, SlTon As Double, GTTon As Double, LakTon As Double
With Sheets("NH")
endR = .Cells(65000, 1).End(3).Row
ArrNh = .Range("A5:P" & endR).Value
End With
With Sheets("XH1")
endR = .Cells(65000, 1).End(3).Row
ArrXh1 = .Range("A5:V" & endR).Value
End With
With Sheets("XH2")
endR = .Cells(65000, 1).End(3).Row
ArrXh2 = .Range("A5:Z" & endR).Value
End With
ReDim ArrData(1 To UBound(ArrNh) + UBound(ArrXh1) + UBound(ArrXh1), 1 To 37)
s = 0
For i = 1 To UBound(ArrNh)
s = s + 1
For k = 1 To UBound(ArrNh, 2)
ArrData(s, k) = ArrNh(i, k) 'SoCTN va ngay
Next k
Next i
''Lay tu XH1
For i = 1 To UBound(ArrXh1)
s = s + 1
For k = 1 To 3
ArrData(s, k) = ArrXh1(i, k) 'SoCTN va ngay
Next k
For k = 4 To 9
ArrData(s, k) = ArrXh1(i, k + 3) 'Tenhang + DVT ...
Next k
For k = 17 To 19
ArrData(s, k) = ArrXh1(i, k - 13) 'SoCTX,NX,DX
Next k
ArrData(s, 20) = ArrXh1(i, 13) 'SLX
ArrData(s, 21) = ArrXh1(i, 15) 'TGX
For k = 22 To 23
ArrData(s, k) = ArrXh1(i, k - 5)
Next k
ArrData(s, 24) = ArrXh1(i, 20)
ArrData(s, 25) = ArrXh1(i, 22)
Next i
''Lay Tu XH2
For i = 1 To UBound(ArrXh2)
s = s + 1
For k = 1 To 3
ArrData(s, k) = ArrXh2(i, k) 'SoCTN va ngay
Next k
For k = 4 To 9
ArrData(s, k) = ArrXh2(i, k + 5) 'Tenhang + DVT...
Next k
For k = 26 To 28
ArrData(s, k) = ArrXh2(i, k - 22) 'SoCTX,NX,DX
Next k
ArrData(s, 29) = ArrXh2(i, 15) 'SLX
ArrData(s, 30) = ArrXh2(i, 20) 'TGX
For k = 31 To 32
ArrData(s, k) = ArrXh2(i, k - 10)
Next k
Next i
'Gan vao
With Sheets("NXT")
.[A6].Resize(1, 37).ClearContents 'Giu lai dong 6 CF
.[A7].Resize(65000, 37).Clear 'Xoa tu dong 7
' 'Format
.Range("A6:AK6").Copy
.[A7].Resize(s, 37).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.[A6].Resize(s, 37) = ArrData
Set myRng = .[A6].Resize(s, 37)
'sort
With myRng
.Sort Key1:=.Cells(1, 2), Order1:=xlAscending, Key2:=.Cells(1, 1 _
), Order2:=xlAscending, Key3:=.Cells(1, 4), Order3:=xlAscending, Header:=xlNo
End With
'set myRng = Nothing
ReDim ArrData(1 To s + 1, 1 To 37)
ArrData = .[A6].Resize(s + 1, 37).Value
End With
''Xy lý Ton
For i = 1 To UBound(ArrData) - 1
If Len(ArrData(i, 11)) = 0 Then 'NN
For k = 12 To 13
ArrData(i, k) = ArrData(i - 1, k)
Next k
End If
If Len(ArrData(i, 29)) > 0 Then 'NN
ArrData(i, 33) = ArrData(i, 12) * ArrData(i, 29)
ArrData(i, 34) = ArrData(i, 13) * ArrData(i, 29)
End If
SlTon = SlTon + ArrData(i, 10) - ArrData(i, 20) - ArrData(i, 29)
GTTon = GTTon + ArrData(i, 14) - ArrData(i, 24) - ArrData(i, 33)
LakTon = LakTon + ArrData(i, 16) - ArrData(i, 25) - ArrData(i, 34)
If ArrData(i, 1) & ArrData(i, 4) <> ArrData(i + 1, 1) & ArrData(i + 1, 4) Then
ArrData(i, 35) = SlTon
ArrData(i, 36) = GTTon
ArrData(i, 37) = LakTon
SlTon = 0: GTTon = 0: LakTon = 0
End If
Next i
'''Gan lai
With Sheets("NXT")
.[A6].Resize(s, 37) = ArrData
End With
Application.CutCopyMode = False
Erase ArrNh(), ArrXh1(), ArrXh2(), ArrData()
End SubLàm thêm 1 sort nữa theo cột 38=cột 5 và cột 4, sau đó bỏ cột 38.
Sub TaoBC()
Dim endR&, i&, s&, k&
Dim ArrNh(), ArrXh1(), ArrXh2(), ArrData()
Dim myRng As Range, SlTon As Double, GTTon As Double, LakTon As Double
With Sheets("NH")
endR = .Cells(65000, 1).End(3).Row
ArrNh = .Range("A5:P" & endR).Value
End With
With Sheets("XH1")
endR = .Cells(65000, 1).End(3).Row
ArrXh1 = .Range("A5:V" & endR).Value
End With
With Sheets("XH2")
endR = .Cells(65000, 1).End(3).Row
ArrXh2 = .Range("A5:Z" & endR).Value
End With
ReDim ArrData(1 To UBound(ArrNh) + UBound(ArrXh1) + UBound(ArrXh1), 1 To 37)
s = 0
For i = 1 To UBound(ArrNh)
s = s + 1
For k = 1 To UBound(ArrNh, 2)
ArrData(s, k) = ArrNh(i, k) 'SoCTN va ngay
Next k
Next i
''Lay tu XH1'
For i = 1 To UBound(ArrXh1)
s = s + 1
For k = 1 To 3
ArrData(s, k) = ArrXh1(i, k) 'SoCTN va ngay'
Next k
For k = 4 To 9
ArrData(s, k) = ArrXh1(i, k + 3) 'Tenhang + DVT ...'
Next k
For k = 17 To 19
ArrData(s, k) = ArrXh1(i, k - 13) 'SoCTX,NX,DX'
Next k
ArrData(s, 20) = ArrXh1(i, 13) 'SLX'
ArrData(s, 21) = ArrXh1(i, 15) 'TGX'
For k = 22 To 23
ArrData(s, k) = ArrXh1(i, k - 5)
Next k
ArrData(s, 24) = ArrXh1(i, 20)
ArrData(s, 25) = ArrXh1(i, 22)
Next i
''Lay Tu XH2'
For i = 1 To UBound(ArrXh2)
s = s + 1
For k = 1 To 3
ArrData(s, k) = ArrXh2(i, k) 'SoCTN va ngay'
Next k
For k = 4 To 9
ArrData(s, k) = ArrXh2(i, k + 5) 'Tenhang + DVT...'
Next k
For k = 26 To 28
ArrData(s, k) = ArrXh2(i, k - 22) 'SoCTX,NX,DX
Next k
ArrData(s, 29) = ArrXh2(i, 15) 'SLX'
ArrData(s, 30) = ArrXh2(i, 20) 'TGX'
For k = 31 To 32
ArrData(s, k) = ArrXh2(i, k - 10)
Next k
Next i
'Gan vao'
With Sheets("NXT")
.[A6].Resize(1, 38).ClearContents 'Giu lai dong 6 CF'
.[A7].Resize(65000, 38).Clear 'Xoa tu dong 7'
' 'Format'
.Range("A6:AK6").Copy
.[A7].Resize(s, 37).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.[A6].Resize(s, 37) = ArrData
Set myRng = .[A6].Resize(s, 37)
'sort'
With myRng
.Sort Key1:=.Cells(1, 2), Order1:=xlAscending, Key2:=.Cells(1, 1 _
), Order2:=xlAscending, Key3:=.Cells(1, 4), Order3:=xlAscending, Header:=xlNo
End With
Set myRng = Nothing
ReDim ArrData(1 To s + 1, 1 To 38)
ArrData = .[A6].Resize(s + 1, 38).Value
End With
''Xy lý Ton'
For i = 1 To UBound(ArrData) - 1
ArrData(i, 38) = ArrData(i, 5) & "-" & ArrData(i, 4)
If Len(ArrData(i, 11)) = 0 Then 'NN
For k = 12 To 13
ArrData(i, k) = ArrData(i - 1, k)
Next k
End If
If Len(ArrData(i, 29)) > 0 Then 'NN
ArrData(i, 33) = ArrData(i, 12) * ArrData(i, 29)
ArrData(i, 34) = ArrData(i, 13) * ArrData(i, 29)
End If
SlTon = SlTon + ArrData(i, 10) - ArrData(i, 20) - ArrData(i, 29)
GTTon = GTTon + ArrData(i, 14) - ArrData(i, 24) - ArrData(i, 33)
LakTon = LakTon + ArrData(i, 16) - ArrData(i, 25) - ArrData(i, 34)
If ArrData(i, 1) & ArrData(i, 4) <> ArrData(i + 1, 1) & ArrData(i + 1, 4) Then
ArrData(i, 35) = SlTon
ArrData(i, 36) = GTTon
ArrData(i, 37) = LakTon
SlTon = 0: GTTon = 0: LakTon = 0
End If
Next i
'''Gan lai
With Sheets("NXT")
.[A6].Resize(s, 38) = ArrData
Set myRng = .[A6].Resize(s, 38)
'sort
With myRng
.Sort Key1:=.Cells(1, 2), Order1:=xlAscending, Key2:=.Cells(1, 1 _
), Order2:=xlAscending, Key3:=.Cells(1, 38), Order3:=xlAscending, Header:=xlNo
End With
myRng.Offset(, 37).Resize(, 1).ClearContents
Set myRng = Nothing
End With
Application.CutCopyMode = False
Erase ArrNh(), ArrXh1(), ArrXh2(), ArrData()
End SubBạn từ từ nghiên cứu code, tôi se cố gáng hướng dẫn từng phần cho bạn hiểu để nếu có vấn đề cần thay đổi thì mình hiểu và làm. Nhất là phải hiểu để biết code ra kết quả có OK.
Bạn có thể cụ thể phần nào bạn chưa hiểu, biết được bạn hiểu tới đâu thì giải thích sẽ đơn giản hơn.
Sub TaoBC()
Dim endR&, i&, s&, k&
Dim ArrNh(), ArrXh1(), ArrXh2(), ArrData()
Dim myRng As Range, SlTon As Double, GTTon As Double, LakTon As DoubleWith Sheets("NH")
endR = .Cells(65000, 1).End(3).Row
ArrNh = .Range("A5:P" & endR).Value
End With
With Sheets("XH1")
endR = .Cells(65000, 1).End(3).Row
ArrXh1 = .Range("A5:V" & endR).Value
End With
With Sheets("XH2")
endR = .Cells(65000, 1).End(3).Row
ArrXh2 = .Range("A5:Z" & endR).Value
End WithReDim ArrData(1 To UBound(ArrNh) + UBound(ArrXh1) + UBound(ArrXh1), 1 To 37)
s = 0Sorry, dòng của bạn mới chính xác, may lúc khai báo là ArrXH1 có số dòng > ArrXH2. Không thì nó báo lỗi thiếu dòng.
