编辑：更新和测试 - 适用于您的设置数据

updated and tested - works for your "setup" data

Sub Sample()

    Dim MYAr, setup
    Dim ws As Worksheet, wsOutput As Worksheet
    Dim Lrow As Long, i As Long, j As Long, rw As Long, col As Long
    Dim arrHeaders


    Set ws = ThisWorkbook.Sheets("Sheet1") '~~> Set this to the relevant worksheet
    Set wsOutput = ThisWorkbook.Sheets.Add '~~> Add a new worksheet for output
    rw = 2 '<< output starts on this row
    arrHeaders = Array("Speaker", "Tables", "People")

    With ws
        Lrow = .Range("B" & .Rows.Count).End(xlUp).Row '~~> get the last row
        For i = 1 To Lrow
            If .Cells(i, 1).Value = "Setup" Then

                wsOutput.Cells(rw, 1).Value = "Setup"
                wsOutput.Cells(rw + 1, 1).Value = "Microphone"

                setup = .Range("B" & i).Value
                If Len(setup) > 0 Then

                    MYAr = SetupToArray(setup)
                    'add the headers
                    wsOutput.Cells(rw, 3).Resize(1, 3).Value = arrHeaders
                    'fill headers across
                    wsOutput.Cells(rw, 3).Resize(1, 3).AutoFill _
                       Destination:=wsOutput.Cells(rw, 3).Resize(1, UBound(MYAr) + 1)
                    'populate the array
                    wsOutput.Cells(rw + 1, 3).Resize(1, UBound(MYAr) + 1).Value = MYAr

                    'figure out the microphone values here....

                    rw = rw + 6
                End If
            End If
        Next i
    End With

End Sub

Function SetupToArray(v)
    Dim MYAr, i
    v = Replace(v, ":", ",")
    v = Replace(v, " x ", ",")
    MYAr = Split(v, ",")
    'trim spaces...
    For i = LBound(MYAr) To UBound(MYAr)
        MYAr(i) = Trim(MYAr(i))
    Next i
    SetupToArray = MYAr
End Function