Question

我会尽力把这个总结一下。此代码是我正在开发的更大的“主”工作簿的一部分。该宏用于通过基于某些所述条件移除一些行来格式化数据，然后通过移动列和一些其他各种事物来格式化数据。我在一个单独的工作表中用一些其他宏编写宏，而我向主服务器添加了模块，宏和代码。代码在其原始工作簿中运行得非常好，但是当我将代码带入主服务器时，它运行速度非常慢，偶尔也会崩溃。

    Sub FeederDel()


  ''unhide fix tab
Sheets("Fix").Visible = True

''''Turns off screen updating 
With Application
    .ScreenUpdating = False
End With

 '''''Unmerge & Delete Pictures
Range("A12:Y250").UnMerge
ActiveSheet.Pictures.Delete

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Paste into fix tab (a quick-fix for #REF! Error)
ActiveSheet.Cells.Select
Selection.Copy
Sheets("Fix").Select
Range("A1").Select
ActiveSheet.Paste

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


'''''Delete unwanted rows, shift up those rows
Dim j As Long
For j = 250 To 13 Step -1
    ' Condition  for CUL
    If Range("D13").Value Like "*CUL*" Then
        ActiveSheet.Range("E14:F250").Cut _
        Destination:=Worksheets("Fix").Range("D14")
        GoTo NextPart

    ' Condition  for customer provided items (coupons/stickers)
    ElseIf ActiveSheet.Cells(j, 4).Value = "" And Cells(j, 7).Value = "" Then
        Rows([j]).EntireRow.Delete xlShiftUp
    ' Condition  for subfeeders
    ElseIf ActiveSheet.Cells(j, 5).Value = "" And Cells(j, 12).Value = "" Then
        Rows([j]).EntireRow.Delete xlShiftUp

    End If
Next j
NextPart:
''''Shift-over(for subfeeder condition)
If ActiveSheet.Range("F12").Value = "" Then
   ActiveSheet.Range("G12:Y250").Cut
   Range("F12").Select
   ActiveSheet.Paste
Else
End If

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Paste Back to Paste Window
ActiveSheet.Cells.Select
Selection.Copy
Sheets("C_Tool_Paste_Window").Select
Range("A1").Select
ActiveSheet.Paste

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'function to delete contents and formats on "fix" tab
    ThisWorkbook.Sheets("Fix").Activate
    Range("A9:CV12").UnMerge
    Range("A1:CV250").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.ClearContents
    ActiveSheet.Pictures.Delete
    ActiveSheet.Range("A1").Select

   'Switch back to paste window
    ThisWorkbook.Sheets("C_Tool_Paste_Window").Activate
    ActiveSheet.Range("A1").Select

''hide fix tab
Sheets("Fix").Visible = False

''''We turn on screenupdating again.
With Application
    .ScreenUpdating = True
End With


End Sub

为什么会这样做？我该如何解决呢？

Excel宏使用for循环崩溃在新工作簿中

0 个答案: