macros不正确地删除表格行

我有一个macros，我运行添加行到一个表，这个信息来自一个SQL数据库。

我的问题是，当我一步一步的macros观，它工作绝对好，并做到了它应该的。 但是，当我运行macros，线路丢失。

任何人都有类似的经验吗？

提前致谢

汤姆

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 

Answer 1

首先，你需要在VBA中定义每个variables的types，即使它们在同一行上。 所以现在你的hvariables实际上是唯一一个定义为整数的variables。 不知道这是否导致你的问题，但它应该是固定的。

我发现，在“ 整理”部分中，删除“数据”范围旁边的列，但“数据”范围可能在先前的条件中被删除。 我可以看到这可能会导致意外的删除。

如果你告诉我们代码在哪里，这将有所帮助。