拆分基于分隔符的单元格值并插入到新列

Question

应将 header 写入每个插入的新列，单元格值应以“,”分隔符分隔。

示例：

之前:

Header name	another columns from right...
value1
value1,value2,value3
value1,value2

之后：

Header name	Header name	Header name
value1
value1	value2	value3
value1	value2

到目前为止我试过：

Function multipleValues(colName As String)

    Set Rng = getHeadersRange(colName)

    colNumber = Rng.Columns(Rng.Columns.Count).Column

    ColLtr = Cells(1, colNumber).Address(True, False)
    ColLtr = Replace(ColLtr, "", "")

    
    Dim indexOfWord As Integer
    Dim maxValues As Integer
    
    'Find out how many new columns needs to be inserted
    
    Dim item As String, newItem As String
    Dim items As Variant, newItems As Variant
    
    maxValues = 0
    
    For Each cell In Rng
    
        items = Split(cell.Value, ",")
        
        If maxValues < UBound(items) Then
            maxValues = UBound(items)
        End If
        
    Next cell
    
    'Insert new columns
    If maxValues > 0 Then
        Columns(Rng.Column).Offset(, 1).Resize(, maxValues).Insert
    End If
    
    'Duplicate the header to the new columns
    
    'For i = 1 To maxValues
    
        'Cells(1, ColLtr + i).Value = colName

    'Next i
    
    'Split the items to columns

    For Each cell In Rng
    
        items = Split(cell.Value, ",")
        maxValues = UBound(items)
        
        For i = 0 To UBound(items)
        
            firstValue = items(0)
            cell.Offset(0, i) = items(i)
            cell.Value = firstValue
            
        Next i
    
    Next cell
    
 
End Function

目前，我得到了新列及其值，header 行值除外。

Answer 1

试试这个（仅适用于 Excel 365）。函数的第一部分应该是带双引号的分隔符，第二部分应该是你的范围。

Function PC_Split(a As String, b As String)
Dim Text() As String
Text = Split(b, a)
PC_Split = Text
End Function

Answer 2

我会做以下事情：

首先找出需要添加多少列。我们通过计算列中的分隔符（逗号）并使用最大值 + 1 来获得拆分后最终将拥有的列数。

然后我们将列的数据读入一个Data数组以便更快地处理，并准备一个计算大小的Output数组。

然后我们将 header 乘以 Output 数组并将数据行拆分到输出数组中。

最后，我们只需要在右侧添加适量的列并填充数组中的数据。

完成。

Option Explicit

Public Sub Example()
    ExpandColumnByDelimiter Columns(1), ","
End Sub

Public Sub ExpandColumnByDelimiter(ByVal ColumnToExpand As Range, Optional ByVal Delimiter As String = ",")
    Dim ws As Worksheet
    Set ws = ColumnToExpand.Parent
    
    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, ColumnToExpand.Column).End(xlUp).Row
    
    ' get data address for formula
    Dim DataAddress As String
    DataAddress = ColumnToExpand.Resize(RowSize:=LastRow - 1, ColumnSize:=1).Offset(RowOffset:=1).Address(True, True, xlA1, True)
    
    ' get max number of columns for output
    Dim MaxColumns As Long
    MaxColumns = Evaluate("=MAX(LEN(" & DataAddress & ")-LEN(SUBSTITUTE(" & DataAddress & ",""" & Delimiter & ""","""")))") / Len(Delimiter) + 1
    
    ' read column data into array
    Dim Data() As Variant
    Data = ColumnToExpand.Resize(RowSize:=LastRow).Value
    
    ' prepare output array
    Dim Output() As Variant
    ReDim Output(1 To LastRow, 1 To MaxColumns) As Variant
    
    ' multiply header
    Dim iHeader As Long
    For iHeader = 1 To MaxColumns
        Output(1, iHeader) = Data(1, 1)
    Next iHeader
    
    ' split data into output array
    Dim SplitData() As String
    Dim iRow As Long
    For iRow = LBound(Data, 1) + 1 To UBound(Data, 1)
        SplitData = Split(Data(iRow, 1), Delimiter)
        
        Dim iCol As Long
        For iCol = LBound(SplitData) To UBound(SplitData)
            Output(iRow, iCol + 1) = SplitData(iCol)
        Next iCol
    Next iRow
    
    ' add new columns to the sheet
    ColumnToExpand.Offset(ColumnOffset:=1).Resize(ColumnSize:=MaxColumns - 1).Insert xlShiftToRight
    
    ' write the data
    ColumnToExpand.Resize(RowSize:=UBound(Output, 1), ColumnSize:=UBound(Output, 2)).Value = Output
End Sub

要转这个

进入这个

/// 编辑

当然，正如 Siddharth Rout 指出的那样，如果您添加扩展数据所需的空白列，您仍然可以使用文本到列功能。最终这个方法会更有效率。

Public Sub ExpandColumnByDelimiter(ByVal ColumnToExpand As Range, Optional ByVal Delimiter As String = ",")
    Dim ws As Worksheet
    Set ws = ColumnToExpand.Parent
    
    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, ColumnToExpand.Column).End(xlUp).Row
    
    ' get data address for formula
    Dim DataAddress As String
    DataAddress = ColumnToExpand.Resize(RowSize:=LastRow - 1, ColumnSize:=1).Offset(RowOffset:=1).Address(True, True, xlA1, True)
    
    ' get max number of columns for output
    Dim MaxColumns As Long
    MaxColumns = Evaluate("=MAX(LEN(" & DataAddress & ")-LEN(SUBSTITUTE(" & DataAddress & ",""" & Delimiter & ""","""")))") / Len(Delimiter) + 1
        
    ' add new columns to the sheet
    ColumnToExpand.Offset(ColumnOffset:=1).Resize(ColumnSize:=MaxColumns - 1).Insert xlShiftToRight
    
    ' text to column
    ColumnToExpand.Resize(RowSize:=LastRow - 1, ColumnSize:=1).Offset(RowOffset:=1) _
        .TextToColumns Destination:=ColumnToExpand.Cells(2, 1), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False,  Other:=True, OtherChar:=Delimiter
        
    ' multiply header
    ColumnToExpand.Cells(1, 1).Resize(ColumnSize:=MaxColumns).Value = ColumnToExpand.Cells(1, 1).Value
End Sub

拆分基于分隔符的单元格值并插入到新列

Split cell value that based on a delimiter and insert to a new columns

excel

vba

split

delimiter

text-to-column