宏错误地删除表格行

时间:2013-11-27 16:59:15

标签: excel vba excel-vba

我有一个宏来运行以向表中添加行,这些信息来自sql数据库。

我的问题是,当我单步执行宏时,它的工作方式绝对正常,并且完全符合预期。但是,当我运行宏时,行会丢失。

任何人都有类似/有任何建议吗?

提前致谢

汤姆

Sub BOMpart()
Dim NoRow, SupRow, i, j, k, h As Integer
Application.ScreenUpdating = False

NoCol = Range("Data").Columns.Count

' Reset Data Range
Application.DisplayAlerts = False
If Range("Data").Rows.Count > 1 Or Range("Data").Cells(1, 1) <> "" Then
    Range("Data").Delete
End If
If Range("Supplier").Rows.Count > 1 Or Range("Supplier").Cells(1, 1) <> "" Then
    Range("Supplier").Delete
End If
If NoCol > 3 Then
    For a = NoCol To 4 Step -1
        Range("Data").Columns(a).Delete
    Next a
End If
Application.DisplayAlerts = True

' Initiate level counter
j = 1
k = 1

' Set up Level 1 BOM
part = Application.InputBox(prompt:="Enter top level part number:")
Range("Supplier").Cells(1, 1) = part
SupRow = Range("Supplier").Rows.Count

If part = False Then
    End
Else
    Sheets("BOMs").ListObjects( _
        "BOMs").Range. _
        AutoFilter Field:=1, Criteria1:=part, Operator:=xlAnd
    Range("BOMs").Columns(4).SpecialCells(12).Copy Destination:=Range("Data").Columns(1)
    Range("BOMs").Columns(4).SpecialCells(12).Copy Destination:=Range("Supplier").Cells(SupRow + 1, 1)

End If

Application.Wait Now + TimeValue("00:00:05")

' Part Description and FAI
NoRow = Range("Data").Rows.Count

For i = 1 To NoRow
    part = Range("Data").Cells(i, k)
    Sheets("Inventory").ListObjects( _
        "Inventory").Range. _
        AutoFilter Field:=1, Criteria1:=part, Operator:=xlAnd
    Range("Inventory").Columns(4).SpecialCells(12).Copy Destination:=Range("Data").Cells(i, k + 1)
    Range("Inventory").Columns(72).SpecialCells(12).Copy Destination:=Range("Data").Cells(i, k + 2)
Next i


' Input additional Levels
Do Until Range("Data").Rows.Count = Application.CountIf(Range("Data").Columns(k), "N/A")

NoRow = Range("Data").Rows.Count
NoCol = Range("Data").Columns.Count

j = j + 1
Sheets("BOM Data").Cells(1, NoCol + 1) = "Level " & j & " Pt No:"
Sheets("BOM Data").Cells(1, NoCol + 2) = "Level " & j & " Pt Desc."
Sheets("BOM Data").Cells(1, NoCol + 3) = "Level " & j & " FAI Req"
k = k + 3
On Error Resume Next
For i = NoRow To 1 Step -1
    If Range("Data").Cells(i, k - 3) <> "N/A" Then
        SupRow = Range("Supplier").Rows.Count

        part = Range("Data").Cells(i, k - 3)

        Sheets("BOMs").ListObjects( _
            "BOMs").Range. _
            AutoFilter Field:=1, Criteria1:=part, Operator:=xlAnd
        nopart = Range("BOMs").SpecialCells(xlVisible).Rows.Count
        If nopart > 0 Then
            Rows(i + 2).Resize(nopart - 1).Insert
            Range("Data").Range(Cells(i, 1), Cells(i, k - 1)).Copy Destination:=Range("Data").Range(Cells(i, 1), Cells(i + nopart - 1, k - 1))
            Range("BOMs").Columns(4).SpecialCells(12).Copy Destination:=Range("Data").Cells(i, k)
            Range("BOMs").Columns(4).SpecialCells(12).Copy Destination:=Range("Supplier").Cells(SupRow + 1, 1)
        Else
            Range("Data").Cells(i, k) = "N/A"
        End If
    Else
        Range("Data").Cells(i, k) = "N/A"
    End If
    nopart = 0
Next i
On Error GoTo 0

NoRow = Range("Data").Rows.Count
For i = 1 To NoRow
    If Range("Data").Cells(i, k) <> "N/A" Then
        part = Range("Data").Cells(i, k)
        Sheets("Inventory").ListObjects( _
            "Inventory").Range. _
        AutoFilter Field:=1, Criteria1:=part, Operator:=xlAnd
        Range("Inventory").Columns(4).SpecialCells(12).Copy Destination:=Range("Data").Cells(i, k + 1)
        Range("Inventory").Columns(72).SpecialCells(12).Copy Destination:=Range("Data").Cells(i, k + 2)
    Else
        Range("Data").Cells(i, k + 1) = "N/A"
        Range("Data").Cells(i, k + 2) = "N/A"
    End If
Next i

Loop

'Tidy Up
Application.DisplayAlerts = False

With Range("Data")
    .Columns(NoCol + 3).Delete
    .Columns(NoCol + 2).Delete
    .Columns(NoCol + 1).Delete
End With
Application.DisplayAlerts = True

'Formatting

With Range("Data")
    .Columns.AutoFit
End With


Sheets("Counter").Cells(1, 2) = 1
MsgBox "Done!"
Application.ScreenUpdating = True
End Sub

1 个答案:

答案 0 :(得分:0)

首先,您需要在VBA中定义每个变量的类型,即使它们位于同一行。所以现在你的h变量实际上是唯一被定义为整数的变量。不确定这是否导致您的问题,但应该修复。

我在整理部分中看到,您删除了与“数据”范围相邻的列,但“数据”范围可能会在之前的条件中被删除。我可以看到这可能会导致意外删除。

如果你告诉我们代码破坏的地方会有所帮助。