拆分单元格字符串以使用这些部分创建两行

Question

我的数据集的格式大致如下：

... / DATA / ...
猫/ 1763 / 9.4 + 5.6 /快乐
... / DATA /...

我想要做的是用连接的数字分开列并将它们分开; 9.4和5.6并创建两个彼此相邻的行，所有其他数据相同：

... / DATA / ...
猫/ 1763 / 9.4 /快乐
猫/ 1763 / 5.6 /快乐
...... / DATA / ...

经历几千行并非所有行都连接在一起。

我做了一些尝试，但是虽然单个组件似乎工作（在不抛出语法错误的意义上）但整个不行。任何想法？

主要功能是'plusinsert'，它从下拉表中获取一个字符串来定位特定的工作表。它从各种论坛片段拼凑而成，希望我可以归功于原作者，但我没有得到这些名字。

Sub CopyR()
Dim cl As Range
Dim r As Long
Set cl = ActiveCell
r = cl.Row
Range("a" & r, Range("CQ" & r)).Copy

End Sub  


Function Extractparts(path As String)
Dim parts

parts = Split(path, "+")
Extract1 = parts(1)
Extract2 = parts(2)
End Function  
Public Sub plusinsert(name As String)

Dim Target2, cell As Range
Dim cellvalue As String

ActiveWorkbook.Sheets(name).Activate
Set Target2 = ActiveSheet.Range(Range("G1"), Range("D65536").End(xlUp))

For Each cell In Target2
If cell.CountIf(cell, "*+*") Then
cellvalue = cell.Value:
Extractparts (cellvalue):
CopyR:
ActiveSheet.Paste:
Application.CutCopyMode = False:
cell.Value = Extract1:
cell.Offset(1, 0).Value = Extract2
Next cell

End Sub

使用列中的数据，我使用以下代码解决了这个问题：

Dim Target, cell, RowRange As Range
Dim cellvalue As String
Dim Count As Integer
' Snippet target range, is for whole column in production.
Set Target = Range("G2:G8")  

Dim TestArray() As String  

For Each cell In Target
  TestArray() = Split(cell.Value, "+"):
  cell.Value = TestArray(0)
  If UBound(TestArray) > 0 Then
  Set RowRange = cell.EntireRow:
  RowRange.Copy:
  RowRange.Insert Shift:=xlUp:
  Application.CutCopyMode = False:
  cell.Value = TestArray(1)
End If
Next cell

Answer 1

注意 »注释掉的部分，您可以在其中调整Column，firstDataRow，deli和{{1} }设置

假设您的数据全部放在delim列中;你的表格看起来像这样：

你运行这段代码

A

得到这样的结果：