Excel 拆分单元格字符串以使用零件创建两行

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

…/DATA/…
猫/1763/9.4+5.6/快乐
…数据/

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

…/DATA/…
猫/1763/9.4/快乐
猫/1763/5.6/快乐
…数据/

通过几千行，并不是所有的行都连接在一起

我做了一些尝试，但尽管单个组件似乎可以工作（在不抛出语法错误的意义上），但整个组件都不行。有什么想法吗

主要函数是“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

注意»注释掉的部分，您可以在其中调整

列

、

第一数据行

、

deli

和

delim

设置

假设您的数据都放在

A列中

；您的工作表如下所示：

您运行此代码

Option Explicit

Sub SplitingAndInserting()

    Dim ws As Worksheet, rng As Range
    Dim i&, deli$, delim$, urColumn$, firstDataRow&

    ' setters
    ' modify them if you need to
    Set ws = Sheets("Sheet1")
    urColumn = "A"
    firstDataRow = 1
    deli = "+"
    delim = "/"

    For i = ws.Range(urColumn & Rows.Count).End(xlUp).Row To firstDataRow Step -1
        Set rng = ws.Range(urColumn & i)
        If InStr(1, rng.Value, deli, vbTextCompare) Then
            Dim var As Variant
            var = Split(rng.Value, deli)
            If UBound(var) > 0 Then
                ws.Rows(i + 1 & ":" & i + 1).Insert Shift:=xlDown
                Dim j&
                Dim fpart As String
                fpart = var(0)
                Dim spart As String
                spart = var(1)
                For j = 1 To Len(spart)
                    If StrComp(delim, Left(Right(spart, j), 1), vbTextCompare) = 0 Then
                        fpart = fpart + Right(spart, j)
                        Exit For
                    End If
                Next j
                rng = fpart
                fpart = var(0)
                For j = 1 To Len(fpart)
                    If StrComp(delim, Left(Right(fpart, j), 1), vbTextCompare) = 0 Then
                        spart = Left(fpart, Len(fpart) - (j - 1)) & spart
                        Exit For
                    End If
                Next j
                rng.Offset(1, 0) = spart
            End If
        End If
        Set rng = Nothing
    Next i

End Sub

要获得这样的结果：

---

向我们展示您尝试的代码。屏幕截图将有助于您在查看编码之前，是否尝试使用Excels[数据]/[文本到列]功能将数据行拆分为不同的单元格（将分隔符设置为“/”然后设置为“+”谢谢大家的帮助。谢谢大家的帮助，如果我的代表足够高，我会给你一个有用的向上投票。@user2539485你仍然可以接受答案：）向上投票下面有一个绿色的复选标记