Question

我有这个VBA脚本，用逗号将单元格中的数据分隔成单独的行，例如如果单元格A1包含数据“ A，B，C，D”，则此脚本将分隔此数据，因此A在一行上，B在下一行上，依此类推（在指定的目标位置）。

我正在尝试更新此脚本，以便在逗号分隔的数据与每个新行连接之前的单元格中的值，即，如果单元格A1包含“ Test”，而单元格B1包含“ A，B，C，D”，则输出行应该是“ TestA”，然后是下一行的“ TestB”，等等。

我对如何执行此任务感到困惑，任何输入都是有益的，我的VBA技能也不是很好。

Sub SplitAll()
Dim xRg As Range
Dim xRg1 As Range
Dim xCell As Range
Dim I As Long
Dim xAddress As String
Dim xUpdate As Boolean
Dim xRet As Variant
On Error Resume Next
xAddress = Application.ActiveWindow.RangeSelection.Address
Set xRg  = Application.InputBox("Please select a range", "Kutools for Excel", xAddress, , , , , 8)
Set xRg  = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
If xRg Is Nothing Then Exit Sub
    If xRg.Columns.Count > 1 Then
        MsgBox "You can't select multiple columns", , "Kutools for Excel"
        Exit Sub
        End If
        Set xRg1 = Application.InputBox("Split to (single cell):", "Kutools for Excel", , , , , , 8)
        Set xRg1 = xRg1.Range("A1")
        If xRg1 Is Nothing Then Exit Sub
            xUpdate = Application.ScreenUpdating
            Application.ScreenUpdating = False
            For Each xCell In xRg
                xRet = Split(xCell.Value, ",")
                xRg1.Worksheet.Range(xRg1.Offset(I, 0), xRg1.Offset(I + UBound(xRet, 1), 0)) = Application.WorksheetFunction.Transpose(xRet)
                I = I + UBound(xRet, 1) + 1
            Next
            Application.ScreenUpdating = xUpdate
        End Sub

Answer 1

它应该完成工作：

Sub SplitAll()
Dim xRg As Range
Dim xRg1 As Range
Dim xCell As Range
Dim yCell As Range
Dim I As Long
Dim xAddress As String
Dim xUpdate As Boolean
Dim xRet As Variant
On Error Resume Next
xAddress = Application.ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Please select a range", "Kutools for Excel", xAddress, , , , , 8)
Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
If xRg Is Nothing Then Exit Sub
    If xRg.Columns.Count > 1 Then
        MsgBox "You can't select multiple columns", , "Kutools for Excel"
        Exit Sub
        End If
        Set xRg1 = Application.InputBox("Split to (single cell):", "Kutools for Excel", , , , , , 8)
        Set xRg1 = xRg1.Range("A1")
        If xRg1 Is Nothing Then Exit Sub
            xUpdate = Application.ScreenUpdating
            Application.ScreenUpdating = False
            For Each xCell In xRg
                xRet = Split(xCell.Value, ",")
                xRg1.Worksheet.Range(xRg1.Offset(I, 0), xRg1.Offset(I + UBound(xRet, 1), 0)) = Application.WorksheetFunction.Transpose(xRet)
                For Each yCell In xRg1.Worksheet.Range(xRg1.Offset(I, 0), xRg1.Offset(I + UBound(xRet, 1), 0))
                    yCell.Value = yCell.Value & xCell.Offset(0, -1).Value
                Next yCell
                I = I + UBound(xRet, 1) + 1
            Next
            Application.ScreenUpdating = xUpdate
End Sub

Answer 2

这是一种方法，尽管您需要适应以提示用户选择范围等。

A, B, C, D

B列中的VBA逗号分隔数据与A列中的文本串联在一起

2 个答案: