Subs被主子crash一個接一個呼叫，但手動一個接一個呼叫，完美運行-有解無憂

我有一個奇怪的問題。我有一組 12 個潛艇來準備一個外部 Excel 檔案。當我將它們組合在一個主子中并執行時，它們會以某種方式崩潰，并且 Excel 檔案最后有錯誤的資料。但是當我轉到VBA視圖并一一執行時，一切都是正確的。附件是正確（手動）執行和損壞（自動）執行結果的螢屏。下面是subs的代碼：

Sub A_PZ_ZST_INB_MVT()
Workbooks.Open ("K:\WAW\Warehouse\ZSMOPL\KomunikatyOS,XML\ZST_INB_MVT.XLSX")
End Sub

Sub B_PZ_konwertujmaterial()
Application.Goto Workbooks("ZST_INB_MVT.XLSX").Sheets("Sheet1").Range("a2")
[C:C].Select
With Selection
    .NumberFormat = "General"
    .Value = .Value
End With
End Sub

Sub C_PZ_konwertujilosc()
Application.Goto Workbooks("ZST_INB_MVT.XLSX").Sheets("Sheet1").Range("a2")
[F:F].Select
With Selection
    .NumberFormat = "General"
    .Value = .Value
End With
End Sub

Sub D_PZ_kolumny()
Workbooks("ZST_INB_MVT.XLSX").Worksheets("Sheet1").Range("A:A").EntireColumn.Insert
Workbooks("ZST_INB_MVT.XLSX").Worksheets("Sheet1").Range("J:J").EntireColumn.Insert
[J:J].Select
With Selection
    .NumberFormat = "General"
    .Value = .Value
    End With
End Sub

Sub E_PZ_prawdafalsz()
    Application.Goto Workbooks("ZST_INB_MVT.XLSX").Sheets("Sheet1").Range("a2")
    Dim i As Integer
    NumRows = Range("D1", Range("D1").End(xlDown)).Rows.Count
  
    Range("A2").FormulaR1C1 = "=RC[2]=R[-1]C[2]"
    Range("A2").Select
    Selection.Copy
    For i = 3 To NumRows
    Range(Cells(3, 1), Cells(i, 1)).Select
    ActiveSheet.Paste
    Next i
End Sub

Sub F_PZ_kopiujinvoice()
Application.Goto Workbooks("ZST_INB_MVT.XLSX").Sheets("Sheet1").Range("a2")
Application.ScreenUpdating = False
    Dim LastRow As Long
    Dim myRow As Long
    
    Application.ScreenUpdating = False
    
'   Find last row in column C with an entry
    LastRow = Cells(Rows.Count, "C").End(xlUp).Row
    
'   Loop through all rows in column C
    For myRow = 1 To LastRow
'       Check to see if current row is blank and row below is populated
        If Cells(myRow, "C") = "" And Cells(myRow   1, "C") <> "" Then
            Cells(myRow, "C") = Cells(myRow   1, "C")
        End If
    Next myRow
    Application.ScreenUpdating = True
End Sub

Sub G_PZ_konwertujinvoice()
Application.Goto Workbooks("ZST_INB_MVT.XLSX").Sheets("Sheet1").Range("a2")
[C:C].Select
With Selection
    .NumberFormat = "General"
    .Value = .Value
End With
End Sub

Sub H_PZ_usunduplikaty()
Application.Goto Workbooks("ZST_INB_MVT.XLSX").Sheets("Sheet1").Range("a2")
    Dim i As Long
    For i = Cells(Rows.Count, "e").End(xlUp).Row To 1 Step -1
    If Cells(i, "e") = "" Then Cells(i, "e").EntireRow.Delete xlUp
    Next i
End Sub

Sub I_PZ_prawdafalsz2()
    Application.Goto Workbooks("ZST_INB_MVT.XLSX").Sheets("Sheet1").Range("a2")
    Worksheets("Sheet1").Columns(1).ClearContents
    Dim i As Integer
    NumRows = Range("b1", Range("b1").End(xlDown)).Rows.Count
      Range("A2").FormulaR1C1 = "=RC[2]=R[-1]C[2]"
    Range("A2").Select
    Selection.Copy
    For i = 3 To NumRows
    Range(Cells(3, 1), Cells(i, 1)).Select
    ActiveSheet.Paste
    Next i
End Sub

Sub J_PZ_puste_wiersze()
    Application.Goto Workbooks("ZST_INB_MVT.XLSX").Sheets("Sheet1").Range("a2")
    Dim i As Long
    Dim xLast As Long
    Dim xRng As Range
    Dim xTxt As String
        NumRows = Range(("D2"), Range("D2").End(xlDown)).Rows.Count
    On Error Resume Next
    xTxt = Application.ActiveWindow.RangeSelection.Address
    Set xRng = Application.Range("$A$2:$A$100")
        xLast = xRng.Rows.Count
    For i = xLast To 1 Step -1
      If InStr(1, xRng.Cells(i, 1).Value, False) > 0 Then
        Rows(xRng.Cells(i, 1).Row).Insert Shift:=xlDown
      End If
    Next
End Sub

Sub K_PZ_kopiujinvoice()
Application.Goto Workbooks("ZST_INB_MVT.XLSX").Sheets("Sheet1").Range("a2")
Application.ScreenUpdating = False
Dim lr As Long
With ActiveSheet
  lr = .Columns("C").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
  On Error Resume Next
  With .Range("C2:C100" & lr)
    .SpecialCells(xlCellTypeBlanks).Formula = "=R[1]C"
    .Value = .Value
  End With
  On Error GoTo 0
End With
Application.ScreenUpdating = True

End Sub

Sub L_PZ_kopiujvendor()
Application.Goto Workbooks("ZST_INB_MVT.XLSX").Sheets("Sheet1").Range("a2")
Application.ScreenUpdating = False
Dim lr As Long
With ActiveSheet
  lr = .Columns("B").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
  On Error Resume Next
  With .Range("B2:B100" & lr)
    .SpecialCells(xlCellTypeBlanks).Formula = "=R[1]C"
    .Value = .Value
  End With
  On Error GoTo 0
End With
Application.ScreenUpdating = True
End Sub

以及將它們全部分組的主要子：

Sub przyjecie()
    A_PZ_ZST_INB_MVT
    B_PZ_konwertujmaterial
    C_PZ_konwertujilosc
    D_PZ_kolumny
    E_PZ_prawdafalsz
    F_PZ_kopiujinvoice
    G_PZ_konwertujinvoice
    H_PZ_usunduplikaty
    I_PZ_prawdafalsz2
    J_PZ_puste_wiersze
    K_PZ_kopiujinvoice
    L_PZ_kopiujvendor
End Sub

正確執行錯誤執行

uj5u.com熱心網友回復：

已解決：事實證明，該函式Rows.Insert實際上是從前一個子粘貼存盤在剪貼板中的函式。我把Application.CutCopyMode = False它解決了我的問題。

謝謝

uj5u.com熱心網友回復：

所有這些程式都可以合二為一。如果有人在代碼運行時不小心更改了活動作業表，
使用也可能會造成整個世界的傷害。您還可以使用三種或四種不同的方法來查找最后一行。Select

最好打開作業簿并將其分配給變數，然后在代碼中使用該參考。與作業表相同 - 無需先選擇它。

發布的必填鏈接：how-to-avoid-using-select-in-excel-vba

話雖如此，這是對您的代碼的重寫。這并不完美，因為我只是按照您的程式順序進行的，但希望能展示出更好的方法。

Public Sub Test()

    'Covers A_PZ_ZST_INB_MVT()
    ''''''''''''''''''''''''''
    Dim wrkBk As Workbook
    Set wrkBk = Workbooks.Open("K:\WAW\Warehouse\ZSMOPL\KomunikatyOS,XML\ZST_INB_MVT.XLSX")
        
    With wrkBk.Worksheets("Sheet1")
        
        'Covers B_PZ_konwertujmaterial() and C_PZ_konwertujilosc()
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        With .Range("C:C,F:F")
            .NumberFormat = "General"
            .Value = .Value
        End With
        
        'Covers D_PZ_kolumny()
        ''''''''''''''''''''''
        .Columns(1).Insert Shift:=xlToRight
        .Columns(10).Insert Shift:=xlToRight
        With .Range("J:J")
            .NumberFormat = "General"
            .Value = .Value
        End With
        
        'Covers E_PZ_prawdafalsz()
        ''''''''''''''''''''''''''
        Dim NumRows As Long
        NumRows = .Cells(Rows.Count, 4).End(xlUp).Row 'Better to start from bottom and go up.
        .Range(.Cells(3, 1), .Cells(NumRows, 1)).FormulaR1C1 = "=RC[2]=R[-1]C[2]"
        
        'Covers F_PZ_kopiujinvoice()... probably a faster way to do this.
        ''''''''''''''''''''''''''''
        Dim LastRow As Long
        LastRow = .Cells(Rows.Count, 3).End(xlUp).Row
        
        Dim myRow As Long
        For myRow = 1 To LastRow
            If .Cells(myRow, 3) = "" And .Cells(myRow   1, 3) <> "" Then
                .Cells(myRow, 3) = .Cells(myRow   1, 3)
            End If
        Next myRow
        
        'Covers G_PZ_konwertujinvoice()
        '''''''''''''''''''''''''''''''
        With .Range("C:C")
            .NumberFormat = "General"
            .Value = .Value
        End With
        
        'Covers H_PZ_usunduplikaty() - probably faster to filter and delete.
        ''''''''''''''''''''''''''''
        For myRow = .Cells(Rows.Count, 5).End(xlUp).Row To 1 Step -1
            If .Cells(myRow, 5) = "" Then .Rows(myRow).Delete Shift:=xlUp
        Next myRow
        
        'Covers I_PZ_prawdafalsz2()
        '''''''''''''''''''''''''''
        .Columns(1).ClearContents
        NumRows = .Cells(Rows.Count, 2).End(xlUp).Row
        .Range(.Cells(3, 1), .Cells(NumRows, 1)).FormulaR1C1 = "=RC[2]=R[-1]C[2]"
        
        'Covers J_PZ_puste_wiersze()
        ''''''''''''''''''''''''''''
        NumRows = .Cells(Rows.Count, 4).End(xlUp).Row
        For myRow = NumRows To 1 Step -1
            'Not sure what you're doing here.
            'Checking if columns A contains False and inserting a row?
            If .Cells(myRow, 1) = False Then
                .Rows(myRow).Insert Shift:=xlDown
            End If
        Next myRow
        
        'Covers K_PZ_kopiujinvoice()
        ''''''''''''''''''''''''''''
        NumRows = .Cells(Rows.Count, 3).End(xlUp).Row
        With .Range(.Cells(2, 3), .Cells(NumRows, 3))
            .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[1]C"
            .Value = .Value
        End With
        
        'Covers L_PZ_kopiujvendor()
        '''''''''''''''''''''''''''
        NumRows = .Cells(Rows.Count, 2).End(xlUp).Row
        With .Range(.Cells(2, 2), .Cells(NumRows, 2))
            .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[1]C"
            .Value = .Value
        End With
    End With

End Sub

轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/410264.html

標籤：

上一篇：即使關閉也將全域變數存盤在Excel中

下一篇：獲取具有多個條件的資料透視表和vlookup