Giúp đỡ về xuất báo cáo (1 người xem)

[atomexec]

Chào các bạn
Mình cần có 1 table ví dụ như file đính kèm,
mình muốn xuất được một report khi nhập một ngày mong muốn, sẽ ra danh sách các sản phẩm tình trạng ngày đó là gì
(xem ví dụ cụ thể trong file)

Nhờ các cao thủ giúp đỡ cám ơn nhiều

 

[befaint]

Chào các bạn
Mình cần có 1 table ví dụ như file đính kèm,
mình muốn xuất được một report khi nhập một ngày mong muốn, sẽ ra danh sách các sản phẩm tình trạng ngày đó là gì
(xem ví dụ cụ thể trong file)
Nhờ các cao thủ giúp đỡ cám ơn nhiều

Chào atomexec,
Bạn click chuột phải vào tên "Sheet1"/ Chọn View Code/ Chép đoạn sao dán vào.
(Nhớ thiết lập cho macro chạy)

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$12" Then
    Dim rng As Range, cll As Range, i As Long, lr As Long
    lr = Sheet1.Range("A65000").End(3).Row
    Set rng = Sheet1.Range("C3:I" & lr)
    Sheet1.Range("B15:C65000").ClearContents
    For Each cll In rng
        If cll.Column Mod 2 = 1 Then
            If CLng(cll.Value) = CLng(Sheet1.Range("C12").Value) Then
                Sheet1.Range("B15").Offset(i).Value = Sheet1.Cells(cll.Row, 2).Value
                Sheet1.Range("B15").Offset(i, 1).Value = Sheet1.Cells(2, cll.Column).Value
                i = i + 1
            End If
        End If
    Next
End If
End Sub

 

[atomexec]

Chào atomexec,
Bạn click chuột phải vào tên "Sheet1"/ Chọn View Code/ Chép đoạn sao dán vào.
(Nhớ thiết lập cho macro chạy)

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$12" Then
    Dim rng As Range, cll As Range, i As Long, lr As Long
    lr = Sheet1.Range("A65000").End(3).Row
    Set rng = Sheet1.Range("C3:I" & lr)
    Sheet1.Range("B15:C65000").ClearContents
    For Each cll In rng
        If cll.Column Mod 2 = 1 Then
            If CLng(cll.Value) = CLng(Sheet1.Range("C12").Value) Then
                Sheet1.Range("B15").Offset(i).Value = Sheet1.Cells(cll.Row, 2).Value
                Sheet1.Range("B15").Offset(i, 1).Value = Sheet1.Cells(2, cll.Column).Value
                i = i + 1
            End If
        End If
    Next
End If
End Sub

Cám ơn bạn, mình làm được rồi
cám ơn nhiều nhiều nhé

 

[atomexec]

Chào atomexec,
Bạn click chuột phải vào tên "Sheet1"/ Chọn View Code/ Chép đoạn sao dán vào.
(Nhớ thiết lập cho macro chạy)

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$12" Then
    Dim rng As Range, cll As Range, i As Long, lr As Long
    lr = Sheet1.Range("A65000").End(3).Row
    Set rng = Sheet1.Range("C3:I" & lr)
    Sheet1.Range("B15:C65000").ClearContents
    For Each cll In rng
        If cll.Column Mod 2 = 1 Then
            If CLng(cll.Value) = CLng(Sheet1.Range("C12").Value) Then
                Sheet1.Range("B15").Offset(i).Value = Sheet1.Cells(cll.Row, 2).Value
                Sheet1.Range("B15").Offset(i, 1).Value = Sheet1.Cells(2, cll.Column).Value
                i = i + 1
            End If
        End If
    Next
End If
End Sub

Bạn ơi cho mình hỏi thêm, trong code này nếu SP1 có 3 ngày giống nhau (ngày gia công,ngày hoàn thiện và ngày nhập kho bằng nhau), thì report xuất ra 3 kết quả cùng sản phẩm SP1
vậy mình muốn: nếu trường hợp có trên 1 ngày giống nhau trong cùng 1 sp thì report xuất ra chỉ lấy ngày cuối cùng thôi (vd với trường hợp trên chỉ lấy ngày nhập kho)

Bạn giúp mình với nhé, cám ơn nhiều

 

[befaint]

Bạn ơi cho mình hỏi thêm, trong code này nếu SP1 có 3 ngày giống nhau (ngày gia công,ngày hoàn thiện và ngày nhập kho bằng nhau), thì report xuất ra 3 kết quả cùng sản phẩm SP1
vậy mình muốn: nếu trường hợp có trên 1 ngày giống nhau trong cùng 1 sp thì report xuất ra chỉ lấy ngày cuối cùng thôi (vd với trường hợp trên chỉ lấy ngày nhập kho)

Bạn giúp mình với nhé, cám ơn nhiều

Bạn thử đoạn sau:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Address = "$C$12" Then
    Dim rng As Range, cll As Range, i As Long, lr As Long, chk As String
    lr = Sheet1.Range("A65000").End(3).Row
    Set rng = Sheet1.Range("C3:I" & lr)
    Sheet1.Range("B15:C65000").Clear
    For Each cll In rng
        If cll.Column Mod 2 = 1 Then
            If CLng(cll.Value) = CLng(Sheet1.Range("C12").Value) Then
                If Sheet1.Cells(cll.Row, 2).Value = chk Then i = i - 1
                Sheet1.Range("B15").Offset(i).Value = Sheet1.Cells(cll.Row, 2).Value
                Sheet1.Range("B15").Offset(i, 1).Value = Sheet1.Cells(2, cll.Column).Value
                chk = Sheet1.Range("B15").Offset(i).Value
                i = i + 1
            End If
        End If
    Next
    Target.Select
End If
Sheet1.Range("B15:C" & i + 14).Borders.LineStyle = xlContinuous
Application.ScreenUpdating = True
End Sub

 

[atomexec]

Bạn thử đoạn sau:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Address = "$C$12" Then
    Dim rng As Range, cll As Range, i As Long, lr As Long, chk As String
    lr = Sheet1.Range("A65000").End(3).Row
    Set rng = Sheet1.Range("C3:I" & lr)
    Sheet1.Range("B15:C65000").Clear
    For Each cll In rng
        If cll.Column Mod 2 = 1 Then
            If CLng(cll.Value) = CLng(Sheet1.Range("C12").Value) Then
                If Sheet1.Cells(cll.Row, 2).Value = chk Then i = i - 1
                Sheet1.Range("B15").Offset(i).Value = Sheet1.Cells(cll.Row, 2).Value
                Sheet1.Range("B15").Offset(i, 1).Value = Sheet1.Cells(2, cll.Column).Value
                chk = Sheet1.Range("B15").Offset(i).Value
                i = i + 1
            End If
        End If
    Next
    Target.Select
End If
Sheet1.Range("B15:C" & i + 14).Borders.LineStyle = xlContinuous
Application.ScreenUpdating = True
End Sub

Ok rồi bạn ơi, Tuyệt vời quá. cám ơn bạn nhé