Excel拆分列数据并添加到新行[重复]答案

【问题标题】：Excel split the column data and add into new row [duplicate]Excel拆分列数据并添加到新行[重复]
【发布时间】：2020-03-05 22:58:27
【问题描述】：

我习惯使用 python，但为此需要在 excel 中进行。

我的输入数据看起来像 I/P 数据，我想获得所需输出中提到的数据。所需的输出应该只是将数据替换到 A 列和 B 列中。还有许多其他列。

任何关于如何在 excel/VBA 中做的线索都会很好。

【问题讨论】：

要处理的范围是多长？就100、1000、20000或更多而言...根据那个大小直接操作范围或使用数组是好的。
A:R 列和行数：1652。但行数可能不同
好的。 A:R 无关紧要，因为只会处理 A:B 列中的数据。如果处理后的数据将在 D:E 列中返回，那会有问题吗？您是否需要在另一个工作表中执行此操作，或者如何执行？ B:B 列上的分隔符销售价值将始终为“;”，或者是否也可以仅肉类“;”？
可以在A和B同一列上替换，也可以在A和B之后添加一个新列。可以吗？
这个想法是，您可以随时更改目的地。该代码将足够简单（但我认为有效）以被理解。而且，请注意，在这里我们不会为提问的人编写代码。我们通常帮助他们用代码解决他们的问题并学习一些东西......但是我现在有一些时间，我会在几分钟内发布答案......

标签： excel vba excel-formula

【解决方案1】：

试试下面的：

代码：

为每个 Mr no 的每一个订单写一行（也许你的代码很小）

Sub test()

Dim LastRowA As Long, LastRowD As Long, i As Long, y As Long
Dim Mr_No As String
Dim arrInput As Variant, arrValues As Variant

With ThisWorkbook.Worksheets("Sheet1")

    'Let as assume that Column A includes the letters. Find LastRow
    LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
    arrInput = .Range("A2:B" & LastRowA)

    For i = LBound(arrInput) To UBound(arrInput)

        Mr_No = arrInput(i, 1)
        arrValues = Split(arrInput(i, 2), ";")

        For y = LBound(arrValues) To UBound(arrValues)
            LastRowD = .Cells(.Rows.Count, "D").End(xlUp).Row + 1
            .Range("D" & LastRowD).Value = Mr_No
            .Range("E" & LastRowD).Value = Trim(arrValues(y))
        Next y

    Next i

End With

End Sub

将值存储在数组中并在最后打印整个数组（更快）

Sub test()

Dim LastRowA As Long, LastRowD As Long, i As Long, y As Long, arrCounter As Long
Dim Mr_No As String
Dim arrInput As Variant, arrValues As Variant
Dim arrResults() As Variant

arrCounter = 0

With ThisWorkbook.Worksheets("Sheet1")

    'Let as assume that Column A includes the letters. Find LastRow
    LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
    arrInput = .Range("A2:B" & LastRowA)

    For i = LBound(arrInput) To UBound(arrInput)

        Mr_No = arrInput(i, 1)
        arrValues = Split(arrInput(i, 2), ";")

        For y = LBound(arrValues) To UBound(arrValues)

            ReDim Preserve arrResults(1, arrCounter)

            arrResults(0, arrCounter) = Mr_No
            arrResults(1, arrCounter) = Trim(arrValues(y))

            arrCounter = arrCounter + 1

        Next y

    Next i

    .Range("D2:E" & arrCounter + 1).Value = WorksheetFunction.Transpose(arrResults)

End With

End Sub

结果：

【讨论】：

@Rocky 我已经导入了另一个我认为我更快的解决方案。你可以两个都试试！希望你能找到你要找的东西！
完美运行！在 excel 中学习编码的最佳实践或资源是什么？
@Rocky 想到了一个耗时且难以手动完成的现实生活场景，并通过编写几行代码来实现自动化。在错误、测试和研究之后，您将学习。您也可以开始在论坛中解决问题变得更有效率。这是我的看法。

【解决方案2】：

请使用下一个代码。它非常快，仅在内存中工作（使用数组）。它还允许分隔符为“;”、“;”（更多空格，但编辑器会更正）或“;”。我的代码一下子把结果放好，可以非常快速的处理上千行。

Sub SplitCells()
  Dim sh As Worksheet, lastR As Long, arrIn As Variant, arrRow As Variant
  Dim arrF As Variant, i As Long, j As Long, n As Long

    Set sh = ActiveSheet ' use here your sheet
    lastR = sh.Range("A" & Cells.Rows.Count).End(xlUp).row
    arrIn = sh.Range("A2:B" & lastR).value
    ReDim arrF(1 To 2, 1 To 2000): n = 1

    For i = 1 To UBound(arrIn, 1)
        arrRow = Split(Trim(arrIn(i, 2)), ";")
        For j = 0 To UBound(arrRow)
             arrF(1, n) = arrIn(i, 1)
             arrF(2, n) = arrRow(j)
             n = n + 1
        Next j
    Next i
    ReDim Preserve arrF(1 To 2, 1 To n - 1)
   sh.Range("D2").Resize(n - 1, 2) = WorksheetFunction.Transpose(arrF)
End Sub

如果您想返回另一个范围内的数组数据，只需将“D2”更改为您需要的任何内容......

【讨论】：