Excel VBA 如果满足条件则添加新行

Question

我正在尝试写一些 VBA 来完成

if row O is not null then copy all data to new row, then in current row clear columns I, J, K, L, M, N
in the newly inserted row clear columns O

我不确定要说明的警告是 - 抛出一个

Type mismatch error

这是我尝试使用的语法

Sub BlueBell()
Application.ScreenUpdating = False
Dim i As Long, y
ReDim y(2 To Range("A" & Rows.Count).End(3).Row)
For i = UBound(y) To LBound(y) Step -1
If Cells(i, "O") Then
    If Cells(i, "I") = "" And Cells(i, "K") = "" And Cells(i, "M") = "" Then
        GoTo DoNothing
    Else
        Rows(i).Copy
        Cells(i, "A").Insert
        Range("I" & i & ":J" & i & ":K" & i & ":L" & i & ":M" & i & ":N" & i & ":O" & i + 1).ClearContents
        GoTo DoNothing
    End If
End If
DoNothing:
Next i
End Sub

Answer 1

除了使用字符串作为布尔表达式的错误之外，您的代码中还有几处可以更改：

Sub BlueBell()
    Application.ScreenUpdating = False
    Dim i As Long  ', y() As Variant
    'ReDim y(2 To Range("A" & Rows.Count).End(3).Row) 'Why use an array?
    For i = Range("A" & Rows.Count).End(3).Row To 2 Step -1
        If Not IsEmpty(Cells(i, "O").Value) Then
            'Avoid the use of GoTo
            If Cells(i, "I").Value <> "" Or _
               Cells(i, "K").Value <> "" Or _
               Cells(i, "M").Value <> "" Then
                Rows(i).Copy
                Cells(i, "A").Insert
                'Don't use a "Ix:Jx:Kx:Lx:Mx:Nx:Ox+1" range - it will lead to problems
                'because even really experienced users don't understand what it does
                Range("I" & i & ":N" & i).ClearContents
                Range("O" & i + 1).ClearContents
            End If
        End If
    Next i
    'It's a good habit to reset anything that you disabled at the start of your code
    Application.ScreenUpdating = True
End Sub

Excel VBA 如果满足条件则添加新行

Excel VBA To Add New Row If Condition Is Met

excel

vba

excel-2013