多列的文本到列 - Excel VBA

Question

我有很多串联数据列，我想用空格分隔它们。

所以从这个：

为此：

这个VBA代码非常接近，

    Sub TextToColumns()

'Deines Last Row
    Dim LastRow As Long
    LastRow = 1048576 'the last row possible in excel
    'optional alternative **LastRow** Code
       'Counts number of rows (counts from last row of Column A):
         'Dim LastRow As Long
         'LastRow = Cells(Rows.Count, "A").End(xlUp).Row

'Counts number of Columns (my headers start in row 1)
    Dim LastColumn As Long
    LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column

'Loops Text to columns
    Dim StartingRow, StartingColumn As Long
    StartingRow = 1

    For StartingColumn = 1 To LastColumn
        Range(Cells(StartingRow, StartingColumn), Cells(LastRow, StartingColumn)).Select

        Selection.TextToColumns , DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True

    Next

End Sub

但我只想在选定的单元格上使用它，它会覆盖数据以提供以下信息：

如何避免覆盖数据，并且仅运行所选单元格上的宏？非常感谢。

Answer 1

试试这个代码。基本上它所做的是遍历 selected 行并将列的每个销售中的所有文本合并为一个字符串，然后将其拆分为列中的每个单元格 space 作为一个分隔符。

记得在运行宏之前 select 一些行。

Sub TextToColumns()

'Counts number of Columns (my headers start in row 1)
    Dim LastColumn As Long
    LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column


'Full strig
    Dim FullString As Variant
'Split string
    Dim SplitString As Variant


'Loops Text to columns

   Dim rng As Range
   Dim lRowSelected As Long
   For Each rng In Selection.Rows

    RowsSelected = rng.Row


        'Making one string from all the cells in the row
        For StartingColumn = 1 To LastColumn

        If StartingColumn = 1 Then

        FullString = Cells(RowsSelected, StartingColumn).Value

        Else

        FullString = FullString & " " & Cells(RowsSelected, StartingColumn).Value
        End If


        Next StartingColumn

            'Splits the string up into each cell with space as a delimiter
            SplitString = Split(FullString, " ")

            For i = 0 To UBound(SplitString)
                Cells(RowsSelected, i + 1).Value = SplitString(i)
                Next i

   Next rng


End Sub

Answer 2

我会

使用 space 分隔符
然后在 space 上分割结果。

下面的代码为您提供了您在 中显示的结果： 原始数据的屏幕截图。

Option Explicit
Sub splitMultipleColumns()
    Dim wsSrc As Worksheet, rSrc As Range, rDest As Range
    Dim vSrc As Variant
    Dim vConcat As Variant
    Dim I As Long, J As Long

'Many ways to do this
Set wsSrc = Worksheets("sheet1")
Set rSrc = wsSrc.Cells(1, 1).CurrentRegion

'put results below original, but they could go anyplace
Set rDest = rSrc.Offset(rSrc.Rows.Count + 2).Resize(columnsize:=1)

vSrc = rSrc 'read into array for processing speed

'create array of concatenated rows
ReDim vConcat(1 To UBound(vSrc, 1), 1 To 1)
For I = 1 To UBound(vSrc, 1)
    For J = 1 To UBound(vSrc, 2)
        vConcat(I, 1) = vConcat(I, 1) & " " & vSrc(I, J)
    Next J
    vConcat(I, 1) = Trim(vConcat(I, 1))
Next I

Application.ScreenUpdating = False

rDest.EntireRow.Clear
rDest = vConcat
rDest.TextToColumns DataType:=xlDelimited, consecutivedelimiter:=True, _
    Tab:=False, semicolon:=False, comma:=False, Space:=True, other:=False

'Fix the Header row
Set rDest = rDest.CurrentRegion
With rDest
    For J = .Columns.Count To 4 Step -1
        If .Item(1, J) <> "" Then
            Range(rDest(1, J), rDest(1, J + 1)).Insert (xlShiftToRight)
        End If
    Next J
    rDest.Style = "Output"
End With

End Sub

多列的文本到列 - Excel VBA

Text to columns for multiple columns - Excel VBA

excel

vba

concat