Chi Tiết Nhập, Xuất từ ngày đến ngày (1 người xem)

[DMQ]

Em có file nhờ các Ac giải dùm, em có ghi trong sheet ChiTiet, xin các Ac xem và giúp em.Cám Ơn Các AC.

 

[phucbugis]

Em có file nhờ các Ac giải dùm, em có ghi trong sheet ChiTiet, xin các Ac xem và giúp em.Cám Ơn Các AC.

chào bạn,

bài này bạn có thể dùng Advanced Filter là được,

bạn mở file, nhập tên hàng vào ô D16, từ ngày vào ô B17, đến ngày ở ô C17 và click nút Loc Nhap Xuat để xem kết quả.

Sub locNhapXuat()
Dim ArrNhap As Range, ArrXuat As Range, dkien As Range
Set ArrNhap = Sheets("Chitietnhap").[A1:D300]
Set ArrXuat = Sheets("Chitietxuat").[A1:G800]
Set dkien = Range("B15:D16")

    If Range("B17") > Range("C17") Then MsgBox ("Tu ngay den ngay chua hop ly"), vbExclamation: Exit Sub
    'Nhap
    ArrNhap.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=dkien, _
        CopyToRange:=[I6:J6], Unique:=False
    'Xuat
    ArrXuat.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=dkien, _
        CopyToRange:=[M6:Q6], Unique:=False


End Sub

Link: https://www.mediafire.com/?qt8lov4s16a6xoj

 

[leonguyenz]

Tham khảo code sửa theo code về mảng của bạn:
[gpecode=vb]
Sub XuatNhap()
Application.ScreenUpdating = False
Dim nR As Long, xR As Long, nK As Long, xK As Long
Dim SlNhap As Long, SlXuat As Long
Dim ArrXuat, ArrNhap, ArrMaXuat, ArrMaNhap
ArrNhap = Sheet2.Range("A2" & Sheet2.[D65535].End(3).Row).Value
ArrXuat = Sheet4.Range("A2:G" & Sheet4.[G65535].End(3).Row).Value
ReDim ArrMaNhap(1 To UBound(ArrNhap), 1 To 2)
ReDim ArrMaXuat(1 To UBound(ArrXuat), 1 To 5)
If Sheet1.[C1] = "" Or Sheet1.[C2] = "" Or Sheet1.[J1] = "" Then
MsgBox "Giai Phap Excel - Cong Cu Tuyet Voi Cua Ban"
Else
For nR = 1 To UBound(ArrNhap, 1)
If ArrNhap(nR, 2) = Sheet1.[J1] Then
If ArrNhap(nR, 1) >= Sheet1.[C1] And ArrNhap(nR, 1) <= Sheet1.[C2] Then
nK = nK + 1
ArrMaNhap(nK, 1) = ArrNhap(nR, 1)
ArrMaNhap(nK, 2) = ArrNhap(nR, 4)
SlNhap = SlNhap + ArrNhap(nR, 4)
End If
End If
Next nR
For xR = 1 To UBound(ArrXuat, 1)
If ArrXuat(xR, 5) = Sheet1.[J1] Then
If ArrXuat(xR, 1) >= Sheet1.[C1] And ArrXuat(xR, 1) <= Sheet1.[C2] Then
xK = xK + 1
ArrMaXuat(xK, 1) = ArrXuat(xR, 1)
ArrMaXuat(xK, 2) = ArrXuat(xR, 2)
ArrMaXuat(xK, 3) = ArrXuat(xR, 3)
ArrMaXuat(xK, 4) = ArrXuat(xR, 4)
ArrMaXuat(xK, 5) = ArrXuat(xR, 7)
SlXuat = SlXuat + ArrXuat(xR, 7)
End If
End If
Next xR
With Sheet1
.[I7:J65535].ClearContents
.[I4] = SlNhap
.[M7:Q65535].ClearContents
.[J4] = SlXuat
If nK > 0 Then .[I7].Resize(nK, 2) = ArrMaNhap
If xK > 0 Then .[M7].Resize(xK, 5) = ArrMaXuat
End With
End If
Application.ScreenUpdating = True
End Sub
[/gpecode]

 

[DMQ]

Cám ơn bạn leonguyenz nhe, mình thích code của bạn hơn!!!!

 

[DMQ]

Giờ em muốn tạo 1 TextBox và 1 ListBox liền kề với TextBox ở Cell J1 để tránh tình trạng gỏ tên hàng vào Cell J1 không đúng. Mong Các AC giúp em với.