Макрос проходит через несколько модулей - PullRequest
Новая
       40

Макрос проходит через несколько модулей

0 голосов
/ 01 марта 2019

Снова прошу вашего совета ... У меня есть пара макросов, которые должны быть активированы Worksheet_Calculate, если определенная ячейка или диапазон изменяется на другом листе.Все работает нормально, но я заметил, что некоторые макросы не останавливаются на «End Sub», а переходят к другим макросам, что приводит к тому, что столбец в таблице не сортируется.Вот что у меня есть: Worksheet_Calculate 

    Private Sub Worksheet_Calculate()
Static OldVal As Variant

If Range("AL2").Value <> OldVal Then
    OldVal = Range("AL2").Value
    Call RF

ElseIf Range("AM2").Value <> OldVal Then
    OldVal = Range("AM2").Value
    Call SEAL

ElseIf Range("AN2").Value <> OldVal Then
    OldVal = Range("AN2").Value
    Call SUVPCR

ElseIf Range("AO2").Value <> OldVal Then
    OldVal = Range("AO2").Value
    Call Segment

ElseIf Range("AU2").Value <> OldVal Then
    OldVal = Range("AU2").Value
    Call RRC

ElseIf Range("AW2").Value <> OldVal Then
    OldVal = Range("AW2").Value
    Call WG

ElseIf Range("AY2").Value <> OldVal Then
    OldVal = Range("AY2").Value
    Call dB

ElseIf Range("BA2").Value <> OldVal Then
    OldVal = Range("BA2").Value
    Call Noise_em


End If

End Sub

Макрос для RF выглядит нормально, если я запускаю его один на F8, он выполняется, не переходя куда-то еще: 

Sub RF()

On Error Resume Next
If Sheets("All_list").Range("AL2").Value = "No" Then
ActiveWorkbook.Worksheets("All_list").ListObjects("All").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("All_list").ListObjects("All").Sort.SortFields.Add2 _
        Key:=Range("All[[#All],[RF]]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("All_list").ListObjects("All").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

ElseIf Sheets("All_list").Range("AL2").Value = "Yes" Then
ActiveWorkbook.Worksheets("All_list").ListObjects("All").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("All_list").ListObjects("All").Sort.SortFields.Add2 _
        Key:=Range("All[[#All],[RF]]"), SortOn:=xlSortOnValues, Order:= _
        xlDescending, DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("All_list").ListObjects("All").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

ElseIf Sheets("All_list").Range("AL2").Value = "All" Then
ActiveWorkbook.Worksheets("All_list").ListObjects("All").Sort.SortFields.Clear
End If

End Sub

Ноэтот (Сегмент) также отлично работает в одиночку, но не в Worksheet_calculate, где он по какой-то причине переходит к RF-послесловиям.

   Sub Segment()

Dim x() As Variant

With Sheets("All_list")

.Range("AP2:AP10").Clear
.Range("AO2:AO10" & .Cells(.Rows.Count, "AO").End(xlUp).Row).Copy
.Range("AP2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

x = Application.Transpose(Sheets("All_list").Range("AP2:AP10").Value)

ActiveWorkbook.Worksheets("All_list").ListObjects("All").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("All_list").ListObjects("All").Sort.SortFields.Add2 _
        Key:=Range("All[Segment]"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        CustomOrder:=Join(x, ","), DataOption:=xlSortNormal

End With

    With ActiveWorkbook.Worksheets("All_list").ListObjects("All").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xl`enter code here`TopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


End Sub

Это в основном означает, что макросы, такие как RF (Seal, SUVPCR), работают нормально вместе и даже сегментируют, но после сегмента ничего не сортируется, все сокращается.Когда я заменяю его на примерный RRC, который похож, RRC функционирует, но опять ничего после него.Любая помощь очень ценится.Спасибо

1 Ответ

0 голосов
/ 03 марта 2019

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

Private Sub Worksheet_Calculate()
Static OldVal As Variant
Static OldVal2 As Variant
Static OldVal3 As Variant
Static OldVal4 As Variant
Static OldVal5 As Variant
Static OldVal6 As Variant
Static OldVal7 As Variant
Static OldVal8 As Variant

Application.EnableEvents = False

If Range("AL2").Value <> OldVal Then
    OldVal = Range("AL2").Value
    Call RF

ElseIf Range("AM2").Value <> OldVal2 Then
    OldVal2 = Range("AM2").Value
    Call SEAL

ElseIf Range("AN2").Value <> OldVal3 Then
    OldVal3 = Range("AN2").Value
    Call SUVPCR


ElseIf Range("AO2").Value <> OldVal4 Then
    OldVal4 = Range("AO2").Value
    Call Segment

ElseIf Range("AU2").Value <> OldVal5 Then
    OldVal5 = Range("AU2").Value
    Call RRC

ElseIf Range("AW2").Value <> OldVal6 Then
    OldVal6 = Range("AW2").Value
    Call WG

ElseIf Range("AY2").Value <> OldVal7 Then
    OldVal7 = Range("AY2").Value
    Call dB

ElseIf Range("BA2").Value <> OldVal8 Then
    OldVal8 = Range("BA2").Value
    Call Noise_em

End If

Application.EnableEvents = True

End Sub

Я забыл назначить OldVal для каждого диапазона отдельно, этот трюк сделал мой день.Я также включил события включения / выключения для обеспечения безопасности, как вы предложили, хотя, похоже, в этом случае это никак не повлияет.Еще раз спасибо за поддержку

...