Valor de patrón de celda a columnas

El formato que muestras en la salida deseada excluye el uso de Power Query (que resultó ser más complicado de lo que pensaba).

Pero aquí hay una rutina VBA que producirá lo que usted muestra de su entrada.

Para entrar en esta Macro (Sub), alt-F11 abre el Editor de Visual Basic. Asegúrese de que su proyecto está resaltado en la ventana del Explorador de proyectos. A continuación, en el menú superior, seleccione Insert/Module y pegue el código siguiente en la ventana que se abre.

Para utilizar esta macro (Sub), alt-F8 abre el cuadro de diálogo de la macro. Seleccione la macro por su nombre y RUN .

La macro asume que su tabla (como se muestra en su captura de pantalla)

• comienza en A1
• Cabeceras de columna de la fila 1
• números secuenciales en la columna A a partir de A2
• Los patrones empiezan en B2

Las notas de la macro, junto con la lectura del código, deberían explicar el algoritmo utilizado. Pero pregunta si algo no está claro.

Option Explicit
Sub patternToColumns()
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes As Variant
    Dim I As Long, J As Long, K As Long, S As String, v As Variant
    Dim arrList As Object, x(1) As Variant
    Dim col As Collection

'read the source data into VBA array
Set wsSrc = ThisWorkbook.Worksheets("Sheet1")
With wsSrc
    vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=2)
End With

'set results destination
Set wsRes = ThisWorkbook.Worksheets("sheet1")
    Set rRes = wsRes.Cells(1, 4) 'D1

Set arrList = CreateObject("System.Collections.ArrayList")
Set col = New Collection

'split string on change in character
'store each pair of character/count as an array within an ArrayList
For I = 2 To UBound(vSrc)
    arrList.Clear
    S = vSrc(I, 2)

    x(0) = Mid(S, 1, 1)
    x(1) = 1

    For J = 2 To Len(S)
        Select Case J
            Case Is < Len(S)
                If Mid(S, J, 1) = x(0) Then
                    x(1) = x(1) + 1
                Else
                    arrList.Add x
                    x(0) = Mid(S, J, 1)
                    x(1) = 1
                End If
            Case Is = Len(S)
                If Right(S, 1) = x(0) Then
                    x(1) = x(1) + 1
                    arrList.Add x
                Else
                    arrList.Add x
                    x(0) = Right(S, 1)
                    x(1) = 1
                    arrList.Add x
                End If
        End Select
    Next J

    'each completed array list represents one row of pattern
    '   and 2 columns of output
    'each collection item = 1 column pair of output
    col.Add Item:=arrList.toarray, Key:=CStr(I)
Next I

'dim results array
I = 0
For Each v In col
    I = IIf(I > UBound(v), I, UBound(v))
Next v

ReDim vRes(0 To I + 1, 1 To col.Count * 2)

'Populate the array

'headers
For J = 1 To UBound(vRes, 2) Step 2
    vRes(0, J) = J / 2 + 0.5
Next J

J = -1

For Each v In col
    J = J + 2
    I = 0
    For K = 0 To UBound(v)
        I = I + 1
        vRes(I, J) = v(K)(0)
        vRes(I, J + 1) = v(K)(1)
    Next K
Next v

'write to worksheet and format
Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
With rRes
    .CurrentRegion.Clear
    .EntireColumn.Clear
    .Value = vRes

    .Replace "d", "day"
    .Replace "n", "night"
    .Replace "x", "off"

    With .Rows(1)
        For J = 1 To .Cells.Count Step 2
            Range(.Cells(J), .Cells(J + 1)).HorizontalAlignment = xlCenterAcrossSelection
        Next J
    End With
    .EntireColumn.AutoFit
    .Style = "Output" 'may need to be more specific with non-English Excel

    Dim C As Range
    For Each C In rRes
        With C
            If .Value = "off" Then
                .Font.Color = RGB(165, 165, 165)
                .Offset(0, 1).Font.Color = RGB(165, 165, 165)
            End If
        End With
    Next C
End With

End Sub