1. Lỗi sổ chi tiết
- Khi mình chạy sổ chi tiết vật tư thì Cột ghi chú ghi lỗi #N/A
View attachment 258597
-
Sub SoChiTiet_NVL()
Dim arrN, arrX, Val
Dim EndR As Long, MSVT As String
Dim Fday As Date, Lday As Date
Dim i As Long, j As Long, EndRVT As Long, p
Dim KQ(), SLDK As Double
Dim SLN As Double, SLX As Double
Application.ScreenUpdating = False
On Error GoTo Loi
Val = Range("D12")
If Len(Val) = 0 Then
MsgBox "Het roi!"
Exit Sub
End If
EndR = ActiveSheet.Range("F" & Rows.Count).End(xlUp).Row
MSVT = Sheet15.Range("D12")
Fday = Sheet15.Range("F10")
Lday = Sheet15.Range("H10")
EndR = Sheet1.Range("D" & Rows.Count).End(xlUp).Row
arrN = Sheet1.Range("C7:J" & EndR).Value
EndR = Sheet21.Range("D" & Rows.Count).End(xlUp).Row
arrX = Sheet21.Range("C8:J" & EndR).Value
SLDK = WorksheetFunction.IfError(WorksheetFunction.VLookup(MSVT, Sheet7.Range("C7:F" & Sheet7.Range("C" & Rows.Count).End(xlUp).Row), 4, 0), "")
ReDim KQ(1 To UBound(arrX), 1 To 7)
'Duyet du lieu nhap
For i = 1 To UBound(arrN)
If UCase(arrN(i, 5)) = UCase(MSVT) Then
If arrN(i, 1) >= Fday And arrN(i, 1) <= Lday Then
j = j + 1
KQ(j, 1) = arrN(i, 2)
KQ(j, 2) = arrN(i, 1)
KQ(j, 3) = WorksheetFunction.IfError(WorksheetFunction.VLookup(arrN(i, 3), Sheet12.Range("C6
" & Sheet12.Range("C" & Rows.Count).End(xlUp).Row), 2, 0), "")
KQ(j, 4) = arrN(i, 7)
KQ(j, 5) = arrN(i, 8)
SLN = SLN + arrN(i, 8)
ElseIf arrN(i, 1) < Fday Then
SLDK = SLDK + arrN(i, 8)
End If
End If
Next i
'Duyet du lieu xuat
For i = 1 To UBound(arrX)
If UCase(arrX(i, 5)) = UCase(MSVT) Then
If arrX(i, 1) >= Fday And arrX(i, 1) <= Lday Then
j = j + 1
KQ(j, 1) = arrX(i, 2)
KQ(j, 2) = arrX(i, 1)
KQ(j, 3) = WorksheetFunction.IfError(WorksheetFunction.VLookup(arrX(i, 3), Sheet12.Range("C6
" & Sheet12.Range("C" & Rows.Count).End(xlUp).Row), 2, 0), "")
KQ(j, 4) = arrX(i, 7)
KQ(j, 6) = arrX(i, 8)
SLX = SLX + arrX(i, 8)
ElseIf arrX(i, 1) < Fday Then
SLDK = SLDK - arrX(i, 8)
End If
End If
Next i
Sheet15.Activate
Range("H17") = SLDK
EndR = Range("C" & Rows.Count).End(xlUp).Row
If EndR > 16 Then
Range("B18" & ":B" & EndR).EntireRow.Delete
End If
If j > 0 Then
Range("B19" & ":B" & 19 + j - 1).EntireRow.Insert
Range("B18").Resize(j, 11).Value = KQ
Range("B18:I" & Range("C" & Rows.Count).End(xlUp).Row).Sort Key1:=Range("C18"), Order1:=xlAscending, Header:=xlNo
ReDim KQ(1 To j + 1, 1 To 8)
KQ = Range("B17:I" & Range("C" & Rows.Count).End(xlUp).Row).Value
For i = 2 To UBound(KQ)
KQ(i, 7) = KQ(i - 1, 7) + KQ(i, 5) - KQ(i, 6)
Next
Range("B17").Resize(j + 1, 8).Value = KQ
Range("F" & j + 20) = SLN
Range("G" & j + 20) = SLX
Range("H" & j + 20) = KQ(j + 1, 7)
Range("D" & j + 20) = "T" & ChrW(7892) & "NG C" & ChrW(7896) & "NG"
Else
For i = 7 To 10
Cells(20, i) = 0
Next
Cells(20, 11) = Cells(17, 11)
Cells(20, 12) = Cells(17, 12)
End If
Application.ScreenUpdating = True
Sheets("SCT").UsedRange
Exit Sub
Loi:
MsgBox "The following error occurred: " & Err.Number & vbCrLf & Err.Description
Application.Calculation = xlCalculationAutomatic
End Sub
2. Lỗi khi chạy báo cáo chi tiết công nợ khách hàng
View attachment 258598
Khi click vào sẽ hiện lỗi
View attachment 258599
Private Sub CommandButton1_Click()
If OptBHCT = True Then
BanHang_ChiTiet
End If
End Sub
Nhờ bạn giúp đỡ mình mấy lỗi này. Cảm ơn bạn
. Code thì nhiều, nếu bị lỗi code thì chỉ sửa ở 1 chỗđúngđịa chỉ nơi phát hiện. Cònđây nói dò hếtđể sửa thì e là hơi vất vả.
