Hãy nói rõ vấn đề của mình. Bạn đưa 1 cái file mà không có dữ liệu gì thì biết nó lỗi ở đâu
Em gửi anh xem giúp em ah.
Mình chưa hiểu cái câu này này
Tức là nếu 1 trong 2 sheet nhập xuất mà không có dữ liệu thì nó báo lỗi? và bạn muốn khắc phục cái đó hả
Anh chạy thử File không có dữ liệu sẽ thấy rõ (hoặc cho dữ liệu 1 dòng bị lỗi sheet nhập hay xuất bị #NA) sẽ báo lỗi ah. Em muốn bỏ qua lỗi đó: bật lại tính năng đã tắt trước đó và không xóa dòng tiêu đề ah. Em cám ơn !
Muốn làm theo 1 cách khác mà biếng. Bạn chờ người viết code đó sửa cho.
Dùng code mới
Option Explicit
Sub DonHang()
Dim aNhap(), aXuat(), aDH(), res(), resN(), resX(), dic As Object
Dim sR&, sRow&, i&, ik&, tN#, tX#, tNhap#, tXuat#, strDH$, strDH2$
On Error Resume Next
With Sheets("TON_KHO")
i = .Range("C" & Rows.Count).End(xlUp).Row
If i < 8 Then MsgBox ("Khong co don hang!"): Exit Sub
aDH = .Range("C8:J" & i).Value
End With
Set dic = CreateObject("scripting.dictionary")
sR = UBound(aDH)
ReDim res(1 To sR, 1 To 5)
For i = 1 To sR
dic.Item(aDH(i, 1) & aDH(i, 3) & aDH(i, 4)) = i
Next i
With Sheets("NHAP")
aNhap = .Range("E2:L" & .Range("E" & Rows.Count).End(xlUp).Row).Value
End With
sRow = UBound(aNhap)
ReDim resN(1 To sRow, 1 To 1)
For i = 2 To sRow
ik = 0
ik = dic.Item(aNhap(i, 1) & aNhap(i, 3) & aNhap(i, 4))
If ik > 0 Then
res(ik, 1) = res(ik, 1) + aNhap(i, 8)
resN(i - 1, 1) = "x"
End If
tN = tN + aNhap(i, 8)
Next i
With Sheets("XUAT")
aXuat = .Range("E2:L" & .Range("E" & Rows.Count).End(xlUp).Row).Value
End With
sRow = UBound(aXuat)
ReDim resX(1 To sRow, 1 To 1)
For i = 2 To sRow
ik = 0
ik = dic.Item(aXuat(i, 1) & aXuat(i, 3) & aXuat(i, 4))
If ik > 0 Then
res(ik, 2) = res(ik, 2) + aXuat(i, 8)
resX(i - 1, 1) = "x"
End If
tX = tX + aXuat(i, 8)
Next i
For i = 1 To sR
res(i, 3) = res(i, 1) - res(i, 2)
res(i, 4) = aDH(i, 8) - res(i, 2)
res(i, 5) = res(i, 3) - res(i, 4)
tNhap = tNhap + res(i, 1)
tXuat = tXuat + res(i, 2)
If aDH(i, 8) < res(i, 1) Then strDH = strDH & aDH(i, 2) & " - " & aDH(i, 3) & " - " & aDH(i, 5) & " - " & (res(i, 1) - aDH(i, 8)) & " " & aDH(i, 6) & vbNewLine
If aDH(i, 8) < res(i, 2) Then strDH2 = strDH2 & aDH(i, 2) & " - " & aDH(i, 3) & " - " & aDH(i, 5) & " - " & (res(i, 2) - aDH(i, 8)) & " " & aDH(i, 6) & vbNewLine
Next i
Call FreezeFile(True)
If UBound(aNhap) > 1 Then Sheets("NHAP").Range("P3").Resize(UBound(resN) - 1) = resN
If UBound(aXuat) > 1 Then Sheets("XUAT").Range("P3").Resize(UBound(resX) - 1) = resX
Sheets("TON_KHO").Range("K8").Resize(sR, 5) = res
If tN <> tNhap Then MsgBox "KIEM TRA PHIEU NHAP"
If tX <> tXuat Then MsgBox "KIEM TRA PHIEU XUAT"
If Len(strDH) > 0 Then Application.Assistant.DoAlert "Thông báo!", "SAN XUAT THUA DON " & vbNewLine & strDH, 0, 4, 0, 0, 0 'MsgBox "SAN XUAT THUA DON " & vbNewLine & strDH
If Len(strDH2) > 0 Then Application.Assistant.DoAlert "Thông báo!", "DA GIAO THUA DON " & vbNewLine & strDH2, 0, 4, 0, 0, 0 'MsgBox "DA GIAO THUA DON " & vbNewLine & strDH2
Call FreezeFile(False)
End Sub
Private Sub FreezeFile(ByVal bFree As Boolean)
Application.ScreenUpdating = Not bFree
Application.EnableEvents = Not bFree
If bFree = True Then
Application.Calculation = xlCalculationManual
Else
Application.Calculation = xlCalculationAutomatic
End If
End SubEm cám ơn anh đã góp ý ah, Công ty em làm hàng gia công nên đây File xuất nhập tồn này có cùng 1 tên Công ty. Theo dõi đã cắt đủ số lượng hay dư số lượng (Sheet Nhập) và Đã giao đủ cho khách hay chưa (Sheet Xuất). Em đang trong quá trình hoàn thiện, có gì sai sót mong anh thông cảm giúp.
Em cám ơn anh rất nhiều, em chạy thấy nhanh hơn lúc trước rất nhiều ah
Option Explicit
Sub ABC()
Dim DicN As Object, DicX As Object
Dim ArrN(), ArrX(), iR&, i&, ArrT(), j&, Key, jj&
Set DicN = CreateObject("scripting.dictionary")
Set DicX = CreateObject("scripting.dictionary")
With Sheets("NHAP")
iR = .Range("C" & Rows.Count).End(3).Row
.Range("P3:P" & iR).ClearContents
ArrN = .Range("C3:P" & iR).Value
For i = 1 To UBound(ArrN, 1)
DicN(ArrN(i, 3) & ArrN(i, 5) & ArrN(i, 6)) = i
Next
End With
With Sheets("XUAT")
iR = .Range("C" & Rows.Count).End(3).Row
.Range("P3:P" & iR).ClearContents
ArrX = .Range("C3:P" & iR).Value
For i = 1 To UBound(ArrX, 1)
DicX(ArrX(i, 3) & ArrX(i, 5) & ArrX(i, 6)) = i
Next
End With
With Sheets("TON_KHO")
iR = .Range("C" & Rows.Count).End(3).Row
.Range("K8:O" & 1000).ClearContents
ArrT = .Range("C8:O" & iR).Value
For i = 1 To UBound(ArrT, 1)
Key = ArrT(i, 1) & ArrT(i, 2) & ArrT(i, 4)
j = DicN(ArrT(i, 1) & ArrT(i, 3) & ArrT(i, 4))
If j > 0 Then
ArrT(i, 9) = ArrT(i, 9) + ArrN(j, 10)
Sheets("NHAP").Range("P" & j + 2) = "x"
If ArrT(i, 9) > ArrT(i, 8) Then MsgBox "Da SX thua"
End If
jj = DicX(ArrT(i, 1) & ArrT(i, 3) & ArrT(i, 4))
If jj > 0 Then
ArrT(i, 10) = ArrT(i, 10) + ArrX(j, 10)
Sheets("XUAT").Range("P" & j + 2) = "x"
If ArrT(i, 10) > ArrT(i, 8) Then MsgBox "Da giao thua"
End If
ArrT(i, 11) = ArrT(i, 9) - ArrT(i, 10)
ArrT(i, 12) = ArrT(i, 8) - ArrT(i, 10)
ArrT(i, 13) = ArrT(i, 11) - ArrT(i, 12)
Next
.Range("C8:O" & iR).Value = ArrT
End With
Set DicN = Nothing: Set DicX = Nothing
End SubEm cám ơn anh rất nhiều ah. Sau khi em test giả định số liệu thừa hoặc thiếu đơn thì hiện bảng thông báo mà không tắt được.
