我有一个宏来运行以向表中添加行,这些信息来自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
答案 0 :(得分:0)
首先,您需要在VBA中定义每个变量的类型,即使它们位于同一行。所以现在你的h
变量实际上是唯一被定义为整数的变量。不确定这是否导致您的问题,但应该修复。
我在整理部分中看到,您删除了与“数据”范围相邻的列,但“数据”范围可能会在之前的条件中被删除。我可以看到这可能会导致意外删除。
如果你告诉我们代码破坏的地方会有所帮助。