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

Question

标题应写入每个插入的新列，并且单元格值应由“，”分隔符分隔。
例子:
之前:


标题名称
右边的另一列...


值(value)1

值1，值2，值3

值1，值2



之后:


标题名称
标题名称
标题名称
右边的另一列...


值(value)1



值(value)1
值(value)2
值(value)3

值(value)1
值(value)2



到目前为止，我尝试过:

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

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

Answer 1

我会做以下事情:
首先找出需要添加多少列。我们通过计算列中的分隔符(逗号)来做到这一点，并使用最大值 + 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, 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