0

我想知道您是否可以帮助我，我编写了一个运行良好的宏，然后每当我对它执行任何操作时，excel 就开始崩溃，我在禁用宏的情况下重新运行了 excel，当我更改任何代码时它仍然崩溃。我不明白这是怎么回事。由于我什至更改它的名称时它都会崩溃，所以我看不出它是代码本身的问题。我在工作表中有两个宏，第二个仍然可以正常运行而不会崩溃。但第一个确实如此。

我设法更改了名称并尝试运行它，它将它改回 Sub DefDec() - 我也不知道这个名称的来源。它以红色突出显示 Sub DefDec，并在此处给出错误的预期标识符。

有任何想法吗？我已将代码添加到底部，并且已经多次重新启动系统。

Private Sub DefDec()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Dim Previous() As Variant
Dim Current() As Variant
Dim Original() As Variant
Dim maxrow As Long
Dim i As Long
Dim p As Long
Dim f As Long
Dim j As Long
Dim o As Long
Dim k As Long
Dim Position() As Long
Dim rng As Range
Dim strTemp As String
Dim N As Long
Dim w As Long
Dim NoExchanges As Integer
Dim pole As String
Dim h As Integer
Dim holidays As Integer

For h = 1 To Worksheets.Count
Worksheets(h).Unprotect Password:=""
Next h

k = 1
i = 3
maxrow = 3
Worksheets(1).Select
Do While Worksheets(1).Cells(i, 1).Value <> "STAT.HOL'S (ST)"
maxrow = maxrow + 1
i = i + 1
Loop


N = maxrow - 4
ReDim Position(0 To maxrow)

Previous = Worksheets(1).Range("a4:a" & maxrow - 1).Value
ReDim Current(1 To UBound(Previous, 1))
ReDim Original(1 To UBound(Previous, 1))
For i = 1 To UBound(Previous, 1)
Current(i) = Previous(i, 1)
Original(i) = Current(i)
Next

'Sorting Feature - sorts the array until there are no more changes

Do
NoExchanges = True
For p = 1 To UBound(Current) - 1

    If Current(p) > Current(p + 1) Then
        NoExchanges = False
        pole = Current(p)
        Current(p) = Current(p + 1)
        Current(p + 1) = pole
    End If
Next p
Loop While Not (NoExchanges)



'Comparison of strings, makes an array with the change of position


For i = 1 To N
For j = 1 To N

    If Original(i) = Current(j) Then
        Position(k) = j
        k = k + 1
    End If

Next j
Next i

For i = 1 To N

Worksheets("Sort Sheet").Range(("C" & i), ("C" & N)).Value = Position(i)

Next i

' Changing the sheet data

For h = 1 To Worksheets.Count
If Worksheets(h).Name = "Calcs" Then
    holidays = h - 1
End If
Next h

Worksheets(1).Select
For i = 1 To N
Worksheets(1).Select
Cells(3 + i, 1).Select
Selection.Value = Current(i)
Next i

For h = 1 To holidays
Worksheets(h).Select
Range(Worksheets(h).Cells(4, 6), Worksheets(h).Cells(4 + N, 70)).Select
Selection.Copy
Worksheets("Sort Sheet").Select
Cells(1, 1).Select
Selection.PasteSpecial
For f = 1 To N
    For i = 1 To N
        If Position(i) = f Then
            Application.CutCopyMode = False

            Range(Worksheets("Sort Sheet").Cells(i, 1), Worksheets("Sort Sheet").Cells(i, 70)).Select
            Selection.Copy


            With Sheets(h)
                .Cells(f + 3, 6).PasteSpecial
            End With
            Application.CutCopyMode = False

            Exit For
        End If
    Next i
Next f
Next h


For h = 1 To 2
If h = 1 Then
    o = 3
Else
    o = 32
End If

Worksheets("FLEXI").Select
Range(Cells(o, 3), Cells(o + N, 150)).Copy
Worksheets("Sort Sheet").Select
Cells(1, 1).Select
Selection.PasteSpecial

For f = 1 To N
    For i = 1 To N

        If Position(i) = f Then
            Application.CutCopyMode = False

            Range(Worksheets("Sort Sheet").Cells(i, 1), Worksheets("Sort Sheet").Cells(i, 150)).Select
            Selection.Copy

            With Sheets("FLEXI")
                .Cells(o + f - 1, 3).PasteSpecial
            End With
            Application.CutCopyMode = False

            Exit For
        End If
    Next i
Next f
Next h

Application.Calculation = xlCalculationAutomatic
skip_update = False
Worksheets("Sort Sheet").UsedRange.Clear
Worksheets(1).Activate
End Sub

谢谢，艾米

4

1 回答 1

0

它现在工作，设法无缘无故地突然更改名称。

于 2013-04-03T09:18:12.117 回答