"Excel перестал работать", когда работает код VBA - PullRequest
Новая
       0

"Excel перестал работать", когда работает код VBA

0 голосов
/ 22 июня 2019

, когда я запускаю свой код VBA, нажимая на командную кнопку, «Excel перестало работать» продолжает появляться, и приложение вылетает. Я пытался выяснить, откуда возникла проблема, нажав F8, но ошибка не появилась.

Вот некоторые условия моей рабочей тетради:

рабочие листы не видны, потому что пользовательская форма закрывает экран отверстия. он исчезнет только при использовании пароля.

Ошибка появляется, когда я нажимаю командную кнопку, чтобы запустить код, но есть 2 исключения:

  1. когда я редактирую свой код (даже несущественные изменения), код будет работать нормально только 1 раз, а затем снова появится ошибка.

  2. когда я использую пароль и запускаю форму пользователя вручную или когда я отлаживаю ее с помощью клавиши F8 

Sub price_rep2()
Unload price_rep_frm


ok = False
For kl = 7 To WorksheetFunction.CountA(Sheets(9).Range("B:B")) + 5
    If Sheets(9).Range("B" & kl) = Sheets(1).Range("B" & Label44.Caption) Then
        ok = True
        Exit For
    End If
Next kl
If ok = False Then
    f = MsgBox("error", vbCritical + vbOKOnly, "error")
    Exit Sub
End If

If Sheets(5).Range("A6") > 10 Then
    uandme = MsgBox("error", vbCritical + vbOKOnly, "error")
    Exit Sub
Else
    Sheets(5).Range("A6") = Sheets(5).Range("A6") + 1
End If
Application.ScreenUpdating = False
Range("A1").Select
Selection.Copy
Cells.Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.ClearContents
Range("A1").Select

Sheets(8).Range("C2") = Sheets(5).Range("KQ12")
Sheets(8).Range("D2") = Sheets(5).Range("KQ45")
Sheets(8).Range("E2") = Sheets(5).Range("KQ46")
Sheets(8).Range("F2") = Sheets(5).Range("KQ47")
Sheets(8).Range("G2") = Sheets(5).Range("KQ48")
Sheets(8).Range("H2") = Sheets(5).Range("KQ49")
Sheets(8).Range("I2") = Sheets(5).Range("KQ50")
Sheets(8).Range("J2") = Sheets(5).Range("KQ51")
Sheets(8).Range("K2") = Sheets(5).Range("KQ60")
Sheets(8).Range("L2") = Sheets(5).Range("KQ52")
Sheets(8).Range("M2") = Sheets(5).Range("KQ53")
Sheets(8).Range("N2") = Sheets(5).Range("KQ54")
Sheets(8).Range("O2") = Sheets(5).Range("KQ55")
Sheets(8).Range("P2") = Sheets(5).Range("KQ56")
Sheets(8).Range("Q2") = Sheets(5).Range("KQ57")
Sheets(8).Range("R2") = Sheets(5).Range("KQ58")
Sheets(8).Range("S2") = Sheets(5).Range("KQ59")
radif = 3
finded = False
For i = 7 To WorksheetFunction.CountA(Sheets(9).Range("B:B")) + 5
    If Sheets(9).Range("B" & i) = Sheets(1).Range("B" & Label44.Caption) And Sheets(9).Range("D" & i) = ComboBox1.Text Then
        Sheets(8).Range("C" & radif) = Sheets(9).Range("C" & i)
        Sheets(8).Range("D" & radif) = Sheets(9).Range("D" & i)
        Sheets(8).Range("F" & radif) = Sheets(9).Range("E" & i) * Sheets(9).Range("F" & i) * (Sheets(9).Range("G" & i))
        Sheets(8).Range("G" & radif) = Sheets(9).Range("H" & i)
        Sheets(8).Range("H" & radif) = Sheets(9).Range("I" & i)
        Sheets(8).Range("I" & radif) = Sheets(9).Range("J" & i)
        Sheets(8).Range("J" & radif) = Sheets(9).Range("K" & i)
        Sheets(8).Range("K" & radif) = Sheets(9).Range("R" & i)
        Sheets(8).Range("L" & radif) = Sheets(9).Range("L" & i)
        Sheets(8).Range("M" & radif) = Sheets(9).Range("M" & i)
        Sheets(8).Range("N" & radif) = Sheets(9).Range("N" & i)
        Sheets(8).Range("O" & radif) = Sheets(9).Range("O" & i)
        Sheets(8).Range("P" & radif) = Sheets(9).Range("P" & i)
        Sheets(8).Range("Q" & radif) = Sheets(9).Range("Q" & i)
        finded = True
        radif = radif + 1
    End If
Next i
If finded = False Then
    Exit Sub
End If


For kl = 7 To WorksheetFunction.CountA(Sheets(3).Range("B:B")) + 5
    If Sheets(3).Range("D" & kl) = ComboBox1.Text And Sheets(3).Range("B" & kl) = Sheets(1).Range("B" & Label44.Caption) Then
        sabt = False
        mat_tot = 0
        For ko = 3 To WorksheetFunction.CountA(Sheets(8).Range("C:C")) + 1
            If Sheets(8).Range("C" & ko) = Sheets(2).Range("C" & (Sheets(3).Range("C" & kl))) Then

                If Sheets(3).Range("AI" & kl) = Sheets(5).Range("KG3") Or Sheets(3).Range("AI" & kl) = Sheets(5).Range("KG6") Then
                    For ki = 9 To 25 Step 2
                        If Sheets(3).Cells(kl, ki) = material_insert_frm.Label79.Caption Or Sheets(3).Cells(kl, ki) = material_insert_frm.Label540.Caption Then
                            If Sheets(3).Range("AC" & kl) <> "" Then
                                mat_tot = mat_tot + (Sheets(3).Cells(kl, ki + 1) * (1 + Sheets(3).Range("AC" & kl)))
                            Else
                                mat_tot = mat_tot + (Sheets(3).Cells(kl, ki + 1))
                            End If
                            sabt = True
                            Exit For
                        End If
                    Next ki


                ElseIf Sheets(3).Range("AI" & kl) = Sheets(5).Range("KG4") Then
                    For ki = 9 To 25 Step 2
                        If Sheets(3).Cells(kl, ki) = material_insert_frm.Label75.Caption Then
                            For ku = 9 To 25 Step 2
                                If Sheets(3).Cells(kl, ku) = material_insert_frm.Label76.Caption Then
                                    If Sheets(3).Range("AC" & kl) <> "" Then
                                        mat_tot = mat_tot + ((((Sheets(3).Cells(kl, ku + 1) * Sheets(3).Cells(kl, ki + 1)) * (1 + Sheets(3).Range("AC" & kl))) / 1000000))
                                    Else
                                        mat_tot = mat_tot + (((Sheets(3).Cells(kl, ku + 1) * Sheets(3).Cells(kl, ki + 1)) / 1000000))
                                    End If
                                    sabt = True
                                    Exit For
                                End If
                            Next ku
                        End If
                        If sabt = True Then
                            Exit For
                        End If
                    Next ki


                ElseIf Sheets(3).Range("AI" & kl) = Sheets(5).Range("KG5") Then
                    For ki = 9 To 25 Step 2
                        If Sheets(3).Cells(kl, ki) = material_insert_frm.Label75.Caption Then
                            If Sheets(3).Range("AC" & kl) <> "" Then
                                mat_tot = mat_tot + (((Sheets(3).Cells(kl, ki + 1) * (1 + Sheets(3).Range("AC" & kl)))))
                            Else
                                mat_tot = mat_tot + ((Sheets(3).Cells(kl, ki + 1)))
                            End If
                            sabt = True
                            Exit For
                        End If
                    Next ki


                ElseIf Sheets(3).Range("E" & kl) = Sheets(5).Range("KO9") Then
                    For ki = 9 To 25 Step 2
                        If Sheets(3).Cells(kl, ki) = material_insert_frm.Label487.Caption Then
                            If Sheets(3).Range("AC" & kl) <> "" Then
                                mat_tot = mat_tot + ((((Sheets(3).Cells(kl, ki + 1) * (1 + Sheets(3).Range("AC" & kl)))) * Sheets(2).Range("F" & (Sheets(3).Range("C" & kl)))) / 1000)
                            Else
                                mat_tot = mat_tot + (((Sheets(3).Cells(kl, ki + 1)) / 1000))
                            End If
                            sabt = True
                            Exit For
                        End If
                    Next ki


                ElseIf Sheets(3).Range("E" & kl) = Sheets(5).Range("KO13") Then
                    For ki = 9 To 25 Step 2
                        If Sheets(3).Cells(kl, ki) = material_insert_frm.Label75.Caption Then
                            For ku = 9 To 25 Step 2
                                If Sheets(3).Cells(kl, ku) = material_insert_frm.Label76.Caption Then
                                    For kou = 9 To 25 Step 2
                                        If Sheets(3).Cells(kl, kou) = material_insert_frm.Label415.Caption Then
                                            If Sheets(3).Range("AC" & kl) <> "" Then
                                                mat_tot = mat_tot + (((Sheets(3).Cells(kl, ku + 1) / 1000 * Sheets(3).Cells(kl, ki + 1) / 1000 * 4) + (Sheets(3).Cells(kl, ki + 1) / 1000 * Sheets(3).Cells(kl, kou + 1) / 1000 * 2) + (Sheets(3).Cells(kl, ku + 1) / 1000 * Sheets(3).Cells(kl, kou + 1) / 1000 * 2)) * (1 + Sheets(3).Range("AC" & kl)))
                                            Else
                                                mat_tot = mat_tot + (((Sheets(3).Cells(kl, ku + 1) / 1000 * Sheets(3).Cells(kl, ki + 1) / 1000 * 4) + (Sheets(3).Cells(kl, ki + 1) / 1000 * Sheets(3).Cells(kl, kou + 1) / 1000 * 2) + (Sheets(3).Cells(kl, ku + 1) / 1000 * Sheets(3).Cells(kl, kou + 1) / 1000 * 2)))
                                            End If
                                            sabt = True
                                            Exit For
                                        End If
                                    Next kou
                                End If
                                If sabt = True Then
                                    Exit For
                                End If
                            Next ku
                        End If
                        If sabt = True Then
                            Exit For
                        End If
                    Next ki
                End If

                If Sheets(3).Range("H" & kl) <> Sheets(5).Range("KO15") Then
                    kode_anbar = True
                Else
                    kode_anbar = False
                End If

                If kode_anbar = True Then
                    For i = 3 To WorksheetFunction.CountA(Sheets(5).Range("KU2:KU1000000")) + 1
                        If Sheets(3).Range("H" & kl) = Sheets(5).Range("KU" & i) Then
                            Sheets(8).Range("E" & ko) = Sheets(8).Range("E" & ko) + (mat_tot * Sheets(5).Range("LA" & i))
                            Exit For
                        End If
                    Next i
                    Exit For
                Else

                    If Sheets(3).Range("AD" & kl) <> "" Then
                        Sheets(8).Range("E" & ko) = Sheets(8).Range("E" & ko) + (mat_tot * Sheets(3).Range("AD" & kl))
                        Exit For
                    End If
                End If
            End If
        Next ko
    End If
Next kl


Sheets(1).Range("A1") = 1
Unload Me
Unload start_frm
yy = WorksheetFunction.CountA(Sheets(8).Range("C:C")) + 1
Sheets(8).Range("C2:S" & yy).Select
With Selection.Font
    .Name = "B Nazanin"
    .Size = 11
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
    .ThemeFont = xlThemeFontNone
End With
Columns("C:S").EntireColumn.AutoFit
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
Sheets(8).Range("C2:S2").Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark2
    .TintAndShade = -0.249977111117893
    .PatternTintAndShade = 0
End With
Set x = ActiveWorkbook
nam = x.Path
Set y = Workbooks.Add
y.SaveAs Filename:=nam & "\price_rep2.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
x.Sheets(8).Copy before:=Workbooks("price_rep2.xlsx").Sheets(1)
Application.ScreenUpdating = True
y.Close (True)
x.Close (True)
End Sub

1 Ответ

0 голосов
/ 28 июня 2019

большое спасибо за ваши ответы, проблема заключалась в использовании "select" в коде.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...