根据分隔符拆分单元格值并插入新列

如何解决根据分隔符拆分单元格值并插入新列

标题应写入每个插入的新列，单元格值应由“,”分隔符分隔。

示例：

之前：

标题名称	右边的另一列...
值1
值1、值2、值3
值1,值2

之后：

标题名称	标题名称	标题名称	右边的另一列...
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,"$1","")

    
    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

目前，除了标题行值之外，我获取了带有其值的新列。

解决方法

我会做以下事情：

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

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

然后我们将标头与 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,ColumnSize:=UBound(Output,2)).Value = Output
End Sub

转这个

进入这个

---

/// 编辑

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

Public Sub ExpandColumnByDelimiter(ByVal ColumnToExpand As Range,"""")))") / 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,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

,

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

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