Ngoctham1994
Thành viên mới
- Tham gia
- 20/2/23
- Bài viết
- 10
- Được thích
- 0
Chào mọi người, em có đoạn code sau để chạy thẻ kho, không biết bị lỗi đọan nào, nhờ anh chị xem giúp ạ.
Option Explicit
Sub LocXuatNhap()
Dim ShN As Worksheet, ShX As Worksheet, ShTK As Worksheet
Dim arr(), kq(), i As Long, a As Long, lr As Long
Dim TuNgay As Date, DenNgay As Date, MaHC As String
Set ShN = Sheets("NHAP")
Set ShX = Sheets("XUAT")
Set ShTK = Sheets("THEKHO")
TuNgay = ShTK.Range("J1").Value
DenNgay = ShTK.Range("J2").Value
MaHC = ShTK.Range("B3").Value
With ShN 'xu ly sheet nhap
lr = .Range("A" & Rows.Count).End(xlUp).Row
arr = .Range("A8:S" & lr).Value
ReDim kq(1 To 10000, 1 To 5)
For i = 1 To UBound(arr, 1)
If arr(i, 4) >= TuNgay And arr(i, 4) <= DenNgay And arr(i, 8) = MaHC Then
a = a + 1
kq(a, 1) = arr(i, 4) 'ngay
kq(a, 2) = arr(i, 2) 'so ct
kq(a, 3) = arr(i, 7) 'ncc/nguoi xuat
kq(a, 4) = arr(i, 12) 'sl nhap
'kq(a, 1) = arr(i, 4) 'sl xuat
End If
Next i
End With
With ShX 'xu ly sheet xuat
lr = .Range("A" & Rows.Count).End(xlUp).Row
arr = .Range("A8:S" & lr).Value
For i = 1 To UBound(arr, 1)
If arr(i, 4) >= TuNgay And arr(i, 4) <= DenNgay And arr(i, 8) = MaHC Then
a = a + 1
kq(a, 1) = arr(i, 4) 'ngay
kq(a, 2) = arr(i, 2) 'so ct
kq(a, 3) = arr(i, 7) 'ncc/nguoi xuat
'kq(a, 4) = arr(i, 12) 'sl nhap
kq(a, 1) = arr(i, 4) 'sl xuat
End If
Next i
End With
'dan ra sheets
If a > 10000 Then
MsgBox "Ket qua vuot qua gioi han", vbCritical
Exit Sub
End If
With ShTK
If a > 0 Then
.Range("A11:E10010").ClearContents 'xoa trang truoc khi dan
.Range("A11").Resize(a, 5).Value = kq 'dan ket qua ra sheet
End If
End With
End Sub
em bị báo là file nặng nên ko gửi dc file, nhờ anh chị xem giúp em đoạn code
Option Explicit
Sub LocXuatNhap()
Dim ShN As Worksheet, ShX As Worksheet, ShTK As Worksheet
Dim arr(), kq(), i As Long, a As Long, lr As Long
Dim TuNgay As Date, DenNgay As Date, MaHC As String
Set ShN = Sheets("NHAP")
Set ShX = Sheets("XUAT")
Set ShTK = Sheets("THEKHO")
TuNgay = ShTK.Range("J1").Value
DenNgay = ShTK.Range("J2").Value
MaHC = ShTK.Range("B3").Value
With ShN 'xu ly sheet nhap
lr = .Range("A" & Rows.Count).End(xlUp).Row
arr = .Range("A8:S" & lr).Value
ReDim kq(1 To 10000, 1 To 5)
For i = 1 To UBound(arr, 1)
If arr(i, 4) >= TuNgay And arr(i, 4) <= DenNgay And arr(i, 8) = MaHC Then
a = a + 1
kq(a, 1) = arr(i, 4) 'ngay
kq(a, 2) = arr(i, 2) 'so ct
kq(a, 3) = arr(i, 7) 'ncc/nguoi xuat
kq(a, 4) = arr(i, 12) 'sl nhap
'kq(a, 1) = arr(i, 4) 'sl xuat
End If
Next i
End With
With ShX 'xu ly sheet xuat
lr = .Range("A" & Rows.Count).End(xlUp).Row
arr = .Range("A8:S" & lr).Value
For i = 1 To UBound(arr, 1)
If arr(i, 4) >= TuNgay And arr(i, 4) <= DenNgay And arr(i, 8) = MaHC Then
a = a + 1
kq(a, 1) = arr(i, 4) 'ngay
kq(a, 2) = arr(i, 2) 'so ct
kq(a, 3) = arr(i, 7) 'ncc/nguoi xuat
'kq(a, 4) = arr(i, 12) 'sl nhap
kq(a, 1) = arr(i, 4) 'sl xuat
End If
Next i
End With
'dan ra sheets
If a > 10000 Then
MsgBox "Ket qua vuot qua gioi han", vbCritical
Exit Sub
End If
With ShTK
If a > 0 Then
.Range("A11:E10010").ClearContents 'xoa trang truoc khi dan
.Range("A11").Resize(a, 5).Value = kq 'dan ket qua ra sheet
End If
End With
End Sub
Bài đã được tự động gộp:
em bị báo là file nặng nên ko gửi dc file, nhờ anh chị xem giúp em đoạn code
Lần chỉnh sửa cuối:
