Macro неправильно удаляет строки таблицы

Question

У меня есть макрос, который я запускаю для добавления строк в таблицу, эта информация поступает из базы данных 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 

Answer 1

Во-первых, необходимо определить тип каждой переменной в VBA, даже если они находятся на одной и той же линии. Итак, теперь ваша переменная h на самом деле единственная, определенная как целое число. Не уверен, что это вызывает вашу проблему, но она должна быть исправлена.

Я вижу, что в разделе Tidy Up вы удаляете столбцы, смежные с диапазоном «данные», но диапазон «Данные» потенциально удалялся в предыдущем условном выражении. Я мог видеть, как это может привести к неожиданным ударам.

Это поможет, если вы сообщите нам, где находится код.