Giúp cho code VBA từ Sheet này sang sheet kia

[lvh1064]

Giúp cho mình code VBA như trong file excel kèm theo:
1. khi mình nhập ngày bất kỳ trong ô màu xanh ở sheet data thì sẽ dò tìm ngày ở sheet detail đúng ngày, sau đó đem toàn bộ dữ liệu trong cột ngày đó sang sheet data theo đúng thứ tự
2. nếu giá trị trả về ở sheet data lớn hơn 0 thì hiện ra , giá trị bằng 0 thì ẩn đi, giá tri dò không có thì trả về cũng ẩn luôn
3. nếu toàn bộ giá trị dò ở sheet detail không có thì hiện hộp thoại " Không có dữ liệu".
Mình xin cám ơn nhiều nhé.

Bài đã được tự động gộp: 6/8/24

 

[SA_DQ]

Bạn trãi nghiệm với con ni xem nó ra răng:

Sub ChuyenSoLieuTheoNgay()
 Dim Dat As Date, Rws As Long, Col As Integer, W As Integer
 Dim Rng As Range, sRng As Range
 Dim DatFormat As String

 Dat = Format([c6].Value, "MM/DD/yyyy")
 With Sheets("Detail")
    Set Rng = .Range(.[c6], .[c6].End(xlToRight))
    Rws = .[b6].CurrentRegion.Rows.Count
    DatFormat = Rng.NumberFormat
    Rng.NumberFormat = "MM/DD/yyyy"
    Set sRng = Rng.Find(Dat, , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        MsgBox "Nothing!"
    Else
        ReDim Arr(1 To Rws, 1 To 2)
        Col = sRng.Column:                  MsgBox Col
        For Each sRng In .[b7].Resize(Rws)
            W = W + 1
            If .[b6].Offset(W) <> "" Then
                Arr(W, 1) = .[b6].Offset(W).Value
                Arr(W, 2) = .[b6].Offset(W, Col - 2).Value
            End If
        Next sRng
    End If
 End With
 [b7].Resize(W, 2).Value = Arr()
 Rng.NumberFormat = DatFormat
End Sub

 

[lvh1064]

Bạn trãi nghiệm với con ni xem nó ra răng:

Sub ChuyenSoLieuTheoNgay()
 Dim Dat As Date, Rws As Long, Col As Integer, W As Integer
 Dim Rng As Range, sRng As Range
 Dim DatFormat As String

 Dat = Format([c6].Value, "MM/DD/yyyy")
 With Sheets("Detail")
    Set Rng = .Range(.[c6], .[c6].End(xlToRight))
    Rws = .[b6].CurrentRegion.Rows.Count
    DatFormat = Rng.NumberFormat
    Rng.NumberFormat = "MM/DD/yyyy"
    Set sRng = Rng.Find(Dat, , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        MsgBox "Nothing!"
    Else
        ReDim Arr(1 To Rws, 1 To 2)
        Col = sRng.Column:                  MsgBox Col
        For Each sRng In .[b7].Resize(Rws)
            W = W + 1
            If .[b6].Offset(W) <> "" Then
                Arr(W, 1) = .[b6].Offset(W).Value
                Arr(W, 2) = .[b6].Offset(W, Col - 2).Value
            End If
        Next sRng
    End If
 End With
 [b7].Resize(W, 2).Value = Arr()
 Rng.NumberFormat = DatFormat
End Sub

Mình vừa làm trong văn phòng, vừa học hỏi thêm môn lập trinh VBA này. Mình rất đam mê và đoạn code bạn viết cho mình có lẽ cao hơn sự hiểu biết của mình nên trước mắt chưa hiểu, đang cố gắng nghiền ngẫm từng bước một nhưng dù sao vẫn cám ơn nhiều vì có cái để suy nghĩ, để tìm hiểu. Cám ơn nhiều nhé