我的想法是把"早"、"晚"、"夜" 的累加數字用變數跑FOR迴圈

結果我先寫在第四列

Sub test()

    Dim str_col As Integer
    Dim end_col As Integer
    
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer

    
    '找最末欄
    end_col = Rows(3).Find("").Column - 1
    
    For str_col = 1 To end_col
    
        If Cells(3, str_col) = "早" Then
            i = i + 1
            Cells(4, str_col) = i
            
        ElseIf Cells(3, str_col) = "晚" Then
            j = j + 1
            Cells(4, str_col) = "A" & j
            
        ElseIf Cells(3, str_col) = "夜" Then
            k = k + 1
            Cells(4, str_col) = "B" & k
            
        End If
        
    Next
    
End Sub

我用Select...Case做

Sub test()
    Dim myRng As Range, rng As Range
    Dim i As Long, j As Long, k As Long
    
    Set myRng = Range("A3:R3")
    
    For Each rng In myRng
        Select Case rng
        Case "早"
            i = i + 1
            rng.Offset(1).Value = i
        Case "晚"
            j = j + 1
            rng.Offset(1).Value = "A" & j
        Case "夜"
            k = k + 1
            rng.Offset(1).Value = "B" & k
        Case Else
        End Select
    Next rng
End Sub