Cho e gửi lại đề tài
Em vẫn bị lối tại vị trí fill đỏ, khi em nhập thêm mới dữ liệu
tại sheet USD E không lọc được kết quả!
Mọi người có thể giúp e khắc phục nó không?
Em gửi file đính kèm bên dưới
[GPECODE=vb]
Sub Loc_1122NKC() 'loc 1122NKC
Dim ws As Worksheet
Dim vung(), dArr()
Dim i As Long, K As Long
Dim tenNganhang As String
Set ws = ThisWorkbook.Sheets("1122NKC") 'dang dung` sheet name <> sheet code name
Set wsUSD = ThisWorkbook.Sheets("USD") 'dang dung` sheet name <> sheet code name
'nha loc
'With ws.ListObjects("Table1").AutoFilter
'If .FilterMode Then .ShowAllData 'phai mo? khoa' truoc'
'End With
vung = ws.Range("tbl_1122NKC").Value '.Range(.Range("A65000").End(xlUp), .Range("l12")).Value
'ket qua xuat' ra chi? co' 10 cot.
'ReDim dArr(1 To UBound(vung, 1), 1 To 10) 'xac dinh kich thuoc mang
ReDim dArr(1 To UBound(vung, 1), 1 To 9)
tenNganhang = wsUSD.Range("USD_tenNH").Value
Dim bThang As Byte
For i = 1 To UBound(vung, 1)
If vung(i, 2) = tenNganhang Then
bThang = Format(vung(i, 4), "m")
If bThang >= Range("USD_tuthang") And bThang <= Range("USD_denthang") Then
K = K + 1
dArr(K, 1) = vung(i, 2) 'ngay ghi so
dArr(K, 2) = vung(i, 3) 'chung tu` (so)
dArr(K, 3) = vung(i, 4) 'chung tu` (ngay thang)
dArr(K, 4) = vung(i, 5) 'dien giai
dArr(K, 5) = vung(i, 6) 'ma KH
dArr(K, 6) = vung(i, 7) 'So phat sinh (Debit)
dArr(K, 7) = vung(i, 8) 'So phat sinh (Credit)
dArr(K, 8) = vung(i, 9) 'Tong tien (No)
dArr(K, 9) = vung(i, 10) 'Tong tien co'
'cot so' 10 la` cthuc se~ do Table tu* dong. Fill xuong'
End If
End If
Next i
If K Then
wsUSD.Select
Range("tbl_USD").Offset(1).EntireRow.Delete 'xoa' row (ko xoa' row 1 trong Table)
'copy gia tri cua? mang? dArr tai. o^ nam ben duoi' header 2 la` 2 o^
Range("tbl_USD[[#Headers],[2]]").Offset(2).Resize(K, 9) = dArr
Erase dArr
End If
MsgBox "Loc_1122NKC xong", vbInformation
End Sub
[/GPECODE]
Em vẫn bị lối tại vị trí fill đỏ, khi em nhập thêm mới dữ liệu
tại sheet USD E không lọc được kết quả!
Mọi người có thể giúp e khắc phục nó không?
Em gửi file đính kèm bên dưới
[GPECODE=vb]
Sub Loc_1122NKC() 'loc 1122NKC
Dim ws As Worksheet
Dim vung(), dArr()
Dim i As Long, K As Long
Dim tenNganhang As String
Set ws = ThisWorkbook.Sheets("1122NKC") 'dang dung` sheet name <> sheet code name
Set wsUSD = ThisWorkbook.Sheets("USD") 'dang dung` sheet name <> sheet code name
'nha loc
'With ws.ListObjects("Table1").AutoFilter
'If .FilterMode Then .ShowAllData 'phai mo? khoa' truoc'
'End With
vung = ws.Range("tbl_1122NKC").Value '.Range(.Range("A65000").End(xlUp), .Range("l12")).Value
'ket qua xuat' ra chi? co' 10 cot.
'ReDim dArr(1 To UBound(vung, 1), 1 To 10) 'xac dinh kich thuoc mang
ReDim dArr(1 To UBound(vung, 1), 1 To 9)
tenNganhang = wsUSD.Range("USD_tenNH").Value
Dim bThang As Byte
For i = 1 To UBound(vung, 1)
If vung(i, 2) = tenNganhang Then
bThang = Format(vung(i, 4), "m")
If bThang >= Range("USD_tuthang") And bThang <= Range("USD_denthang") Then
K = K + 1
dArr(K, 1) = vung(i, 2) 'ngay ghi so
dArr(K, 2) = vung(i, 3) 'chung tu` (so)
dArr(K, 3) = vung(i, 4) 'chung tu` (ngay thang)
dArr(K, 4) = vung(i, 5) 'dien giai
dArr(K, 5) = vung(i, 6) 'ma KH
dArr(K, 6) = vung(i, 7) 'So phat sinh (Debit)
dArr(K, 7) = vung(i, 8) 'So phat sinh (Credit)
dArr(K, 8) = vung(i, 9) 'Tong tien (No)
dArr(K, 9) = vung(i, 10) 'Tong tien co'
'cot so' 10 la` cthuc se~ do Table tu* dong. Fill xuong'
End If
End If
Next i
If K Then
wsUSD.Select
Range("tbl_USD").Offset(1).EntireRow.Delete 'xoa' row (ko xoa' row 1 trong Table)
'copy gia tri cua? mang? dArr tai. o^ nam ben duoi' header 2 la` 2 o^
Range("tbl_USD[[#Headers],[2]]").Offset(2).Resize(K, 9) = dArr
Erase dArr
End If
MsgBox "Loc_1122NKC xong", vbInformation
End Sub
[/GPECODE]
Lần chỉnh sửa cuối:

