Lấy dòng tiêu đề ngày điền vào danh sách chi tiết của ngày đó (1 người xem)

[Excel365]

Nhờ các anh chị giúp em viết code lấy dòng tiêu đê ngày, sau đó điền vào danh sách chi tiết của ngày đó bên cột B.
Mỗi ngày tô 1 màu khác nhau
Trân trọng cảm ơn

 

[ndu96081631]

Nhờ các anh chị giúp em viết code lấy dòng tiêu đê ngày, sau đó điền vào danh sách chi tiết của ngày đó bên cột B.

Bạn cứ dùng hàm IF bình thường thử xem. Tôi nghĩ nó quá đơn giản đi (suy nghĩ trong 5 giây)

Mỗi ngày tô 1 màu khác nhau

Cái này thì hơi... LỐ.
31 ngày sẽ tô 31 màu? Thật không giống ai

 

[phucbugis]

Nhờ các anh chị giúp em viết code lấy dòng tiêu đê ngày, sau đó điền vào danh sách chi tiết của ngày đó bên cột B.
Mỗi ngày tô 1 màu khác nhau
Trân trọng cảm ơn

bạn tham khảo 2 cách:
(1) công thức thông thường ở cột B + CF (Conditional Formatting)
(2) dùng Macro, click Button 1
'-----------
việc điền mỗi ngày một màu (nếu trúng màu khó nhìn thấy thì ôi thôi ) --> "ko được chuẩn" thay vào đó bạn kẻ Border + Bold để phân biệt mỗi ngày là được ...

Sub gpe_test()
Dim ws As Worksheet, vung(), dArr()
Dim i As Long, tmp As String, K As Long, iHeader As String
    
    Set ws = Sheets("Sheet1")
    vung = ws.Range(ws.Range("D5000").End(xlUp), ws.Range("D1")).Value
    '1 To UBound(vung, 1): vong` lap duyet tu` dong` 1 den' dong` cuoi' cung` vung` chon.
    ReDim dArr(1 To UBound(vung, 1), 1 To 1) 'khai bao kich thuoc mang
    '-------
    For i = 1 To UBound(vung, 1)
        tmp = vung(i, 1)
        K = K + 1
        '--------
        'If tmp <> "" And Left(tmp, 4) = "Ngày" Then
        If Left(tmp, 4) = "Ngày" Then
            dArr(K, 1) = tmp
            iHeader = tmp
        Else
            dArr(K, 1) = iHeader 'hoac: dArr(K, 1) = dArr(K - 1, 1)
        End If
    Next
    '-------
    If K Then
        ws.Range("E1:E5000").ClearContents
        ws.Range("E1").Resize(K, 1) = dArr
    End If
    
    Set ws = Nothing: Erase vung
End Sub

 

[Ba Tê]

Mần thử theo IF của ndu96081631 gợi ý xem sao.
Thêm 1 code chạy thử xem có nỗi không.
[GPECODE=vb]Public Sub MauMe()
Application.ScreenUpdating = False
Dim Rng As Range, Cll As Range, Ngay As String, Mau As Long
Set Rng = Range([E1], [E1].End(xlDown))
For Each Cll In Rng
If IsNumeric(Mid(Cll, 6, 2)) Then
Mau = IIf(Mau = 20, 36, 20)
Ngay = Cll.Value
End If
Cll.Offset(, 1) = Ngay
Cll.Resize(, 2).Interior.ColorIndex = Mau
Next Cll
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub[/GPECODE]