如果符合条件,Excel VBA添加新行

时间:2017-04-22 00:40:30

标签: excel vba excel-vba excel-2013

我正在尝试编写一些将完成

的VBA
  

如果行O不为null,则将所有数据复制到新行,然后在当前行中清除列I,J,K,L,M,N
  在新插入的行清除列O

我不确定的问题是-抛出

  

类型不匹配错误

以下是我尝试使用的语法

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

1 个答案:

答案 0 :(得分: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