Excel 是否能够在保留相邻列的值的同时拆分单元格？ 第一个表中的IDs列在每个需要拆分的单元格中包含多个值。但是，唯一的问题是将[name]和[description]信息按ID保留到新表中。

以下VBA代码执行转置粘贴选项。这就是我开始用Chr（10）或新行作为分隔符拆分单元格的原因：

Sub splitText()
'splits Text active cell using ALT+10 char as separator
Dim splitVals As Variant
Dim totalVals As Long

splitVals = Split(ActiveCell.Value, Chr(10))
totalVals = UBound(splitVals)
Range(Cells(ActiveCell.Row, ActiveCell.Column + 1), Cells(ActiveCell.Row, ActiveCell.Column + 1 + totalVals)).Value = splitVals

End Sub

---

除此之外，我还在寻找想法

这比您的解决方案要复杂一些，因为您必须在目标单元格下方插入正确数量的行，然后将ID和其他数据复制到新行中。这里有一个例子可以帮助你

当我计算

偏移量

值时，我使用了一个小技巧。我这样做是因为您可以假设

Split

函数中的所有数组都将从0开始索引，但我个人的习惯是编写可以使用0或1下限的代码。计算并使用

偏移量

可以使循环和索引都工作

Option Explicit

Sub test()
    SplitText ActiveCell
End Sub

Sub SplitText(ByRef idCell As Range)
    Dim splitVals As Variant
    Dim totalVals As Long
    splitVals = Split(idCell.Value, Chr(10))
    If LBound(splitVals) = -1 Then
        '--- the split character wasn't found, so exit
        Exit Sub
    End If

    Dim offset As Long
    offset = IIf(LBound(splitVals) = 0, 1, 0)
    totalVals = UBound(splitVals) + offset

    Dim idSheet As Worksheet
    Set idSheet = idCell.Parent

    Dim idRow As Long
    idRow = idCell.Row

    '--- insert the number of rows BELOW the idCell to hold all
    '    the split values
    Dim i As Long
    For i = 1 To totalVals - 1
        idSheet.Rows(idRow + 1).Insert
    Next i

    '--- now add the IDs to all the rows and copy the other columns down
    Const TOTAL_COLUMNS As Long = 3
    Dim j As Long

    Dim startIndex As Long
    startIndex = LBound(splitVals) + offset
    For i = startIndex To totalVals
        idCell.Cells(i, 1) = splitVals(i - offset)
        For j = 2 To TOTAL_COLUMNS
            idCell.Cells(i, j) = idCell.Cells(1, j)
        Next j
    Next i
End Sub

也许这会有帮助：

Sub splitText()
    'splits Text active cell using ALT+10 char as separator
    Dim splitVals As Variant
    Dim lngRow As Long, lngEl As Long

    With Sheet2
        'Range A2:A5
        For lngRow = 5 To 2 Step -1
            splitVals = Split(.Range("A" & lngRow).Value, Chr(10))
            'the first value
            .Range("A" & lngRow).Value = splitVals(0)
            'remaining values
            For lngEl = 1 To UBound(splitVals)
                .Rows(lngRow + lngEl).Insert
                .Range("A" & lngRow + lngEl).Value = splitVals(lngEl)
                .Range("B" & lngRow + lngEl & ":C" & lngRow + lngEl).Value = .Range("B" & lngRow & ":C" & lngRow).Value
            Next lngEl
        Next lngRow
    End With
End Sub

根据需要更改工作表代码/名称和范围

之前：

之后：