Question

我再次向您征求意见... 我有几个宏，如果某个单元格或范围在另一个工作表上发生更改，则应该由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）之类的宏可以正常运行，甚至可以运行Segment，但是在segment似乎没有排序之后，一切都削减了。当我用类似的示例RRC代替它时，该RRC起作用了，但之后没有任何作用。很感谢任何形式的帮助。谢谢

Answer 1

好的，谢谢大家，已经解决了

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分配给每个范围，这一招使我度过了一天。正如您所建议的，我还提供了安全起停事件，尽管在这种情况下似乎完全没有作用。再次感谢您的支持

宏通过几个模块

1 个答案: