[英]How to insert a blank row based on cell value
I am trying to look for cell values in column C and insert a blank row just above the cell if it doesn't contain a dot (".").我试图在 C 列中查找单元格值,如果单元格不包含点 (“.”),则在该单元格正上方插入一个空白行。
I tried the following macro:我尝试了以下宏:
Sub testing()
Dim col As Variant
Dim lr As Long
Dim i As Long
Dim startRow As Long
col = "C"
startRow = 2
lr = Cells(Rows.Count, col).End(xlUp).Row
With ActiveSheet
For i = lr To startRow Step -1
If IsNumeric(Range("E2", "E" & lr).Value) = True Then
.Cells(i + 1, col).EntireRow.Insert shift:=xlUp
End If
Next i
End With
End Sub
Input输入
Desired Output所需 Output
A slightly different approach where the insert happens at the end:一种稍微不同的方法,插入发生在最后:
Sub Tester()
Dim c As Range, rng As Range, ws As Worksheet, v
Set ws = ActiveSheet
For Each c In ws.Range("C2:C" & ws.Cells(Rows.Count, "C").End(xlUp).Row).Cells
v = c.Value
If InStr(v, ".") = 0 And Len(v) > 0 Then 'has a value, with no "." ?
If rng Is Nothing Then 'any previous cells found?
Set rng = c 'start the range with `c`
Else
Set rng = Application.Union(c, rng) 'add `c` to `rng`
End If
End If
Next c
'if found any cells then do the insert
If Not rng Is Nothing Then rng.EntireRow.Insert shift:=xlDown
End Sub
There are two mistakes in your code:您的代码中有两个错误:
IsNumeric
on the whole column E up to the row you are currently working on.IsNumeric
,直到您当前正在处理的行。 But multiple cells don't have a numeric value. It should be它应该是
Sub testing()
Dim col As String
Dim i As Long
Dim startRow As Long
Dim lastRow As Long
col = "C"
startRow = 2
lastRow = Cells(Rows.Count, col).End(xlUp).Row
With ActiveSheet
For i = lastRow To startRow Step -1
If IsNumeric(Range("E" & i).Value) = False Then
.Cells(i, col).EntireRow.Insert shift:=xlDown
End If
Next i
End With
End Sub
You could even do away with the column E, since VBA contains a function called InStr
that looks for characters or strings inside another string, like this:您甚至可以取消列 E,因为 VBA 包含一个名为
InStr
的 function,它在另一个字符串中查找字符或字符串,如下所示:
If InStr(Range("C" & i).Value, ".") = 0 Then
' ...
End If
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.