あなたが私を助けることができるかどうか疑問に思いました.私はうまく機能するマクロを書きましたが、それを使って何かをするたびにExcelがクラッシュし始めました.マクロを無効にしてExcelを再実行しましたが、コードを変更するとクラッシュします. 何が起こっているのかわかりません。名前を変えてもクラッシュするので、コード自体に問題があるとは思えません。ワークシートに 2 つのマクロがありますが、2 つ目のマクロはクラッシュすることなく正常に動作します。しかし、最初のものはそうします。
名前を変更して実行してみると、 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
ありがとう、エイミー