简体   繁体   English

当范围包含特定文本时插入多行

[英]Insert multiple rows when range contains specific text

I am trying to have a macro to run through a column of data and insert a row for every instance it counts a "," so for example it would insert another 3 rows above Joanne我正在尝试使用一个宏来遍历一列数据,并为它计算为“,”的每个实例插入一行,因此例如它会在 Joanne 上方插入另外 3 行

在此处输入图像描述

I currently have this code below but it doesn't work and im not sure im on the right track for it as I think it is looking for "," to only be the only contents in the cell?我目前有下面这段代码,但它不起作用,我不确定我是否在正确的轨道上,因为我认为它正在寻找“,”只是单元格中的唯一内容? Any help/guidance would be greatly appreciated.任何帮助/指导将不胜感激。

Sub InsertRow()
Dim cell As Range
For Each cell In Range("E2:E9999")
    If cell.Value = "," Then
        cell.EntireRow.Insert
    End If
Next cell
End Sub

Insert As Many Rows As There Are Commas插入与逗号一样多的行

Option Explicit

Sub InsertCommaRows()
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
    
    Application.ScreenUpdating = False
    
    Dim cString As String
    Dim CommasCount As Long
    Dim r As Long
    
    For r = lRow - 1 To 2 Step -1
        Debug.Print ws.Cells(r, "E").Address(0, 0)
        cString = CStr(ws.Cells(r, "E").Value)
        CommasCount = Len(cString) - Len(Replace(cString, ",", ""))
        If CommasCount > 0 Then
            ws.Cells(r + 1, "E").Resize(CommasCount).EntireRow _
                .Insert xlShiftDown, xlFormatFromLeftOrAbove
        End If
    Next r

    Application.ScreenUpdating = True

    MsgBox "Comma-rows inserted.", vbInformation

End Sub

This code counts the commas then inserts the same number of rows immediately below the current cell.此代码对逗号进行计数,然后在当前单元格正下方插入相同数量的行。

Sub InsertRow()
Dim cell As Range
Dim iCommas As Integer
For Each cell In ActiveSheet.Range("E2:E9999")
    iCommas = Len(cell.Value) - Len(Replace(cell.Value, ",", ""))
    If iCommas > 0 Then
        cell.Offset(1).Resize(iCommas).EntireRow.Insert xlDown
    End If
Next cell
End Sub

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM