Excel 根据区域中使用的单元格数量，在行下添加其他行

基本上我需要把一个有几个值的单元格，用逗号分隔成更多的单元格。然后我需要在新单元格下创建确切数量的单元格，以便能够在以后转置此范围以创建新表

在这张图片中，你可以看到我所拥有和需要的一个例子。我需要匿名分析数据。还有数百行需要更改，如示例中的2行

这是我目前的代码：

Sub texttocolumns()

Dim rng As Range
Dim x As Integer

x = ActiveSheet.UsedRange.Rows.Count

For i = x - 2 To 1

Cells(2 + i, 8).texttocolumns _
Destination:=Cells(2 + i, 9), _
Comma:=True

    k = Application.WorksheetFunction.CountA("A" & "2 + i"" & "":" & "AT1")

            Cells(2 + i, 1).Rows(k).Insert
Next i

End Sub

---

我现在找不到我的错误，有人能帮我吗？谢谢

您是否喜欢这项工作：

'A1 = A,B,C,D,E,F,G
'A2 = 1,2,3,4,5,6,7
'A3 = A!B!C!D!E!F!G

'Test procedure will result in:
'A - G in cells A1:A7
'1,2,3,4,5,6,7 in cell A8.
'A - G in cells A9:A15

Sub Test()
    TextToColumns Sheet1.Range("A1")
    TextToColumns Sheet1.Range("A9"), "!"
End Sub

Public Sub TextToColumns(Target As Range, Optional Delimiter As String = ",")

    Dim rng As Range
    Dim lCount As Long
    Dim x As Long

    'How many delimiters in target string?
    lCount = Len(Target) - Len(Replace(Target, Delimiter, ""))

    'Add the blank rows.
    For x = 1 To lCount + 1
        Target.Offset(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Next x

    'Split the string.
    Target.TextToColumns Target, xlDelimited, xlTextQualifierNone, , , , , , True, Delimiter

    'Use TRANSPOSE formula to paste to rows and then remove formula.
    With Target.Offset(1).Resize(lCount + 1, 1)
        .FormulaArray = "=TRANSPOSE(R" & Target.Row & "C:R" & Target.Row & "C" & lCount + 1 & ")"
        .Value = .Value
    End With

    'Delete the original text string.
    Target.EntireRow.Delete

End Sub

---

编辑：

要从“宏”对话框中使用，可以添加以下小过程：

Public Sub Test()  

    Dim y As Long

    y = ActiveSheet.UsedRange.Rows.Count

    With ActiveSheet
        For y = 5 To 1 Step -1
            TextToColumns .Cells(y, 1)
        Next y
    End With

End Sub  

注意：

ActiveSheet.UsedRange.Rows.Count是查找最后一行的糟糕方法。

请参阅此线程：
由于输出结果被发布到不同的位置，因此可以避免插入行的昂贵任务

请尝试此过程，通过从源范围生成两个数组来避免使用源范围：

包含固定字段的数组
包含需要拆分的字段的数组
程序如下：

请参阅以下页面以更好地了解所使用的资源：











这一行
k=Application.WorksheetFunction.CountA（“A”和“2+i”和“：”和“AT1”）
没有意义。此外，由于您使用的是VBA，因此可能会有一种更直接的方法来实现您所需的功能，即尝试以手动方式来实现。建议我们浏览一下您的原始数据和预期结果，这样我们就可以提供完整的解决方案。谢谢，我同意您的看法，可能不可能完全理解我的意思。我将添加更多信息不要用你们收到的答案和评论来改变你们原来的问题，这只会让你们问题的新读者感到困惑，特别是当你们不知道如何实施这些改变的时候。如果没有
步骤
参数，i=x-2到1的这一行
将不起作用。如果您不提供您所质疑的其他信息，则可能会关闭。当我要运行宏时，TextToColumns子项不会显示，因此我无法尝试这样做，不幸的是，它不会出现在宏对话框中，因为它需要参数-它需要知道拆分哪个单元格，以及是否应该使用逗号或其他分隔符<代码>测试
将出现在宏对话框中，它将执行两次
TextToColumns
（一次在单元格A1上，一次在单元格A9上）。我将添加一些代码，这些代码将像您的原始代码一样执行…非常棒，工作得非常好。不幸的是，我根本不明白发生了什么，需要一些时间来理解代码。非常感谢。阅读提供的页面，如果您逐行调试代码（使用
[F8]
），那么您将看到每条指令的作用。不要忘记接受提供最佳解决方案的答案，这有助于我们保持网站的更新。
    Sub Range_Split_A_Field()
    Dim wsTrg As Worksheet, rgOutput As Range
    Dim aFld_1To5  As Variant, aFld_6 As Variant
    Dim aFld As Variant
    Dim lRow As Long, L As Long

        lRow = 3
        Set wsTrg = ThisWorkbook.Sheets("Sht(2)")
        Application.Goto wsTrg.Cells(1), 1

        With wsTrg.Cells(lRow, 1).CurrentRegion
            Set rgOutput = .Rows(1).Offset(0, 10)
            .Rows(1).Copy
            rgOutput.PasteSpecial
            Application.CutCopyMode = False
            aFld_1To5 = .Offset(1, 0).Resize(-1 + .Rows.Count, 5).Value2
            aFld_6 = .Offset(1, 5).Resize(-1 + .Rows.Count, 1).Value2
        End With

        lRow = 1
        For L = 1 To UBound(aFld_1To5)
            aFld = aFld_6(L, 1)
            If aFld = vbNullString Then
                rgOutput.Offset(lRow).Resize(1, 5).Value = WorksheetFunction.Index(aFld_1To5, L, 0)
                rgOutput.Offset(lRow, 5).Resize(1, 1).Value = aFld
                lRow = 1 + lRow

            Else
                aFld = Split(aFld, Chr(44))
                aFld = WorksheetFunction.Transpose(aFld)
                rgOutput.Offset(lRow).Resize(UBound(aFld), 5).Value = WorksheetFunction.Index(aFld_1To5, L, 0)
                rgOutput.Offset(lRow, 5).Resize(UBound(aFld), 1).Value = aFld
                lRow = lRow + UBound(aFld)

        End If: Next

        End Sub