拆分单元格并插入新行 [英] Split cells and insert in a new row

问题描述

我的数据包括标题.在C列中，单元格有时包含"/"或，".目的是拆分这些单元格，并在每个子字符串的下方插入新行.

My data includes headers. In column C, the cells sometimes contain "/" or ",". The goal is to split these cells and insert a new row underneath with every sub-string.

输入

输出

使用下面的代码，我已经能够将所有的，"替换为"/".用"/"定界符分割C列中的单元格，然后粘贴在下面.我无法将拆分功能数组中每个元素的行内容复制并粘贴到下面.似乎每次都粘贴从单元格C2开始的拆分值.

With the code below I have been able to replace all "," with "/". Split the cell in column C by the "/" delimiter and paste underneath. I have not been able to copy and paste the contents of the row underneath with every element in the split function array. It also seems to be pasting the split values beginning in cell C2 every time.

    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

推荐答案

插入或删除行时始终从下至上进行.要保留拆分值的顺序，请从最后到第一.

When inserting or deleting rows always work from the bottom up. To retain the order of the split value, work from last to first.

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

这篇关于拆分单元格并插入新行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！