-4

Как мне преобразовать данные этого опроса:

1 ответ1

1

Приведенный ниже код VBA поможет вам решить проблему, но помните, что он работает только для столбца.

    Private Sub CommandButton1_Click()

    Dim xRg As Range
    Dim xRg1 As Range
    Dim xCell As Range
    Dim I As Long
    Dim xAddress As String
    Dim xUpdate As Boolean
    Dim xRet As Variant

    On Error Resume Next

    xAddress = Application.ActiveWindow.RangeSelection.Address

    Set xRg = Application.InputBox("Select Input Range", "Transpose Data", xAddress, , , , , 8)
    Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)

    If xRg Is Nothing Then Exit Sub
        If xRg.Columns.Count > 1 Then
            MsgBox "You Can't Select Multiple Columns", , "Transpose Data"
            Exit Sub
            End If

            Set xRg1 = Application.InputBox("Split to (Single Cell):", "Transpose Data", , , , , , 8)
            Set xRg1 = xRg1.Range("A1")

            If xRg1 Is Nothing Then Exit Sub
                xUpdate = Application.ScreenUpdating
                Application.ScreenUpdating = False
                For Each xCell In xRg
                    xRet = Split(xCell.Value, ",")
                    xRg1.Worksheet.Range(xRg1.Offset(I, 0), xRg1.Offset(I + UBound(xRet, 1), 0)) = Application.WorksheetFunction.Transpose(xRet)
                    I = I + UBound(xRet, 1) + 1
                Next
                Application.ScreenUpdating = xUpdate

End Sub

Надеюсь, это поможет вам.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .