Question

我的数据包含标题。在C列中，单元格有时包含＆＃34; /＆＃34;或＆＃34;，＆＃34;。目标是拆分这些单元格并在每个子字符串下面插入一个新行。

通过以下代码，我已经能够替换所有＆＃34;，＆＃34;用＆＃34; /＆＃34;。通过＆＃34; /＆＃34;拆分C列中的单元格下面划分和粘贴。我无法使用split函数数组中的每个元素复制和粘贴下面行的内容。它似乎也粘贴了每次从单元格C2开始的分割值。

    Sub SuspenseReport()
        Dim SearchCell As Variant
        Dim i As Integer
        Dim cell As Range
        Application.ScreenUpdating = False

        Set Rng = Application.Range("C2:C1000") '*Change Last Row Value Here
        vLr = ActiveCell.SpecialCells(xlLastCell).Row

        For Each cell In Rng
        cell = Replace(cell, ",", "/")

        If InStr(1, cell, "/") <> 0 Then
        SearchCell = Split(cell, "/")
        For i = 0 To UBound(SearchCell)

        Cells(i + 2, 2).Value = SearchCell(i)
        Next i
        End If

        Next cell

        Application.ScreenUpdating = True
   End Sub

Answer 1

插入或删除行时，始终从下往上工作。要保留拆分值的顺序，请从上到下进行操作。

Option Explicit

Sub splitSlash()
    Dim tmp As Variant, i As Long, j As Long

    With Worksheets("sheet1")
        .Columns("C").Replace what:=Chr(44), replacement:=Chr(47), lookat:=xlPart
        For i = .Cells(.Rows.Count, "A").End(xlUp).Row To 2 Step -1
            tmp = Split(.Cells(i, "C").Value2 & Chr(47), Chr(47))
            For j = UBound(tmp) - 1 To LBound(tmp) + 1 Step -1
                .Cells(i + 1, "A").EntireRow.Insert
                .Cells(i + 1, "A") = .Cells(i, "A").Value2
                .Cells(i + 1, "B") = .Cells(i, "B").Value2
                .Cells(i + 1, "C") = tmp(j)
            Next j
            .Cells(i, "C") = tmp(j)
        Next i
    End With
End Sub

拆分单元格并插入新行

1 个答案: