Hiện luôn những hàng hóa có tồn đầu =0 (1 người xem)

[quykh]

Code này đã loại khỏi kết quả những hàng hoá không có (=0) ở tồn đầu kỳ, nhập, và xuất . Nay em muốn hiện luôn những hàng hóa có tồn đầu kỳ(nhập, xuất) = 0 . Mong các Anh chị giúp đỡ.
Sub BaoCaoNhapXuatTon()
Application.ScreenUpdating = False
''Nap cac Du lieu nhap
Dim DmvTon(), MhNhap(), ddNhap(), SlgNhap(), MhXuat(), SlgXuat(), ddXuat()
Dim nDM As Long, nNhap As Long, nXuat As Long, nRes As Long
Dim Dic, arNXT(), aAdd()
Dim i As Long, k As Long, ddFr As Long, ddTo As Long, ik As ColRes

'Nhap cac du lieu Danh muc Hang Hoa va TonDau
With Range("DMvTON")
If .Offset(1).Value <> "" Then
DmvTon = Range(.Offset(1), .Offset(1).End(xlDown)).Resize(, 4).Value2
nDM = UBound(DmvTon)
Else
MsgBox "Xem lai Du lieu Danh muc va Ton", vbOKOnly + vbCritical, "Danh muc va Ton"
Exit Sub
End If
End With

'Nhap Du lieu NHAP
With Range("NHAP")
If .Offset(1).Value <> "" Then
MhNhap = Range(.Offset(1), .End(xlDown)).Value2
nNhap = UBound(MhNhap)
SlgNhap = .Offset(1, 3).Resize(nNhap).Value2
ddNhap = .Offset(1, -2).Resize(nNhap).Value2
Else
MsgBox "Xem lai Du lieu chung tu NHAP", vbOKOnly + vbCritical, "Chung tu Nhap"
Exit Sub
End If
End With

'Nhap Du lieu XUAT
With Range("XUAT")
If .Offset(1).Value <> "" Then
MhXuat = Range(.Offset(1), .End(xlDown)).Value2
nXuat = UBound(MhXuat)
SlgXuat = .Offset(1, 3).Resize(nXuat).Value2
ddXuat = .Offset(1, -4).Resize(nXuat).Value2
Else
MsgBox "Xem lai Du lieu chung tu XUAT", vbOKOnly + vbCritical, "Chung tu Xuat"
Exit Sub
End If
End With

'Nhap Du lieu Tu Ngay -> Den Ngay
ddFr = Range("TUNGAY").Value2
ddTo = Range("DENNGAY").Value2

Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To nDM
Dic(DmvTon(i, 1)) = i
Next i

ReDim arNXT(1 To nDM + 10, idTonDK To idXuat)

For i = 1 To nDM
arNXT(i, idTonDK) = DmvTon(i, 4)
Next i

ReDim Preserve aAdd(1 To 1)
nRes = nDM
For i = 1 To nNhap
If ddNhap(i, 1) <= ddTo Then
k = Dic(MhNhap(i, 1))
If k = 0 Then
nRes = nRes + 1: k = nRes: Dic(MhNhap(i, 1)) = k
ReDim Preserve aAdd(1 To nRes - nDM): aAdd(nRes - nDM) = MhNhap(i, 1)
End If

If ddNhap(i, 1) < ddFr Then 'ton
arNXT(k, idTonDK) = arNXT(k, idTonDK) + SlgNhap(i, 1)
Else 'trong ky
arNXT(k, idNhap) = arNXT(k, idNhap) + SlgNhap(i, 1)
End If
End If
Next i

For i = 1 To nXuat
If ddXuat(i, 1) <= ddTo Then
k = Dic(MhXuat(i, 1))
If k = 0 Then
nRes = nRes + 1: k = nRes: Dic(MhXuat(i, 1)) = k
ReDim Preserve aAdd(1 To nRes - nDM): aAdd(nRes - nDM) = MhXuat(i, 1)
End If

If ddXuat(i, 1) < ddFr Then 'ton
arNXT(k, idTonDK) = arNXT(k, idTonDK) - SlgXuat(i, 1)
Else 'trong ky
arNXT(k, idXuat) = arNXT(k, idXuat) + SlgXuat(i, 1)
End If
End If
Next i
Range("KETQUA").Offset(1).Resize(6000, idTonCK).ClearContents

With Range("KETQUA").Offset(1)
k = -1
For i = 1 To nRes
If arNXT(i, idTonDK) <> 0 Or arNXT(i, idNhap) <> 0 Or arNXT(i, idXuat) <> 0 Then
k = k + 1
.Offset(k, idNo - 1).Value = k + 1
If i <= nDM Then
.Offset(k, idMaHang - 1) = DmvTon(i, 1)
.Offset(k, idTenHang - 1) = DmvTon(i, 2)
.Offset(k, idDVT - 1) = DmvTon(i, 3)
Else
.Offset(k, idMaHang - 1) = aAdd(i - nDM)
End If

For ik = idTonDK To idXuat
.Offset(k, ik - 1) = arNXT(i, ik)
Next
.Offset(k, idTonCK - 1) = arNXT(i, idTonDK) + arNXT(i, idNhap) - arNXT(i, idXuat)
End If
Next i
End With
k = k + 1
Application.ScreenUpdating = True

If nRes > nDM Then
MsgBox "Chuong trinh ket thuc" _
& vbLf & "co tat ca " & k & " ma hang duoc tinh NXT" _
& vbLf & vbLf & "Co " & nRes - nDM & " mat hang cuoi chua co trong Danh muc", _
vbOKOnly + vbCritical, "THONG BAO"
Else
MsgBox "Chuong trinh ket thuc" _
& vbLf & "co tat ca " & k & " ma hang duoc tinh NXT", _
vbOKOnly, "THONG BAO"
End If
End Sub