[已解决]VBA代码改成按钮启动

wszsp

我有一代码，是由A1,或C1，或者D1 单元格触发。我想改成由按钮开关控制宏的启动，可是不会修改。
哪位老师帮助改一改。

谢谢！


Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
    If Target.Address = "$A$1" Or Target.Address = "$C$1" Or Target.Address = "$D$1" Then
        If Target.Count = 1 Then
            Dim ar, br()
            Dim i As Long, j As Long
            Dim qs As Date, jz As Date, sr As String
            Set my = Sheets("销售提成统计")
            With my
                qs = .Cells(1, 1): jz = .Cells(1, 3): sr = Cells(1, 4)
                ar = Sheets("汇总").Cells(3, 1).CurrentRegion
                For i = 1 To UBound(ar)
                    If Trim(ar(i, 11)) = Trim(sr) Then
                        j = j + 1
                        ReDim Preserve br(1 To 10, 1 To j)

                        br(1, j) = ar(i, 2)
                        br(2, j) = ar(i, 3)

                        br(3, j) = ar(i, 4)
                        br(4, j) = ar(i, 5)
                        br(5, j) = ar(i, 6)
                         br(6, j) = ar(i, 7)

                        br(7, j) = ar(i, 8)
                        br(8, j) = ar(i, 9)
                        br(9, j) = ar(i, 10)

                    End If
                Next i
                .Cells(10, 1).Resize(j, 10).ClearContents
                .Cells(10, 1).Resize(j, 10) = Application.Transpose(br)
            End With
        End If
    End If
    Application.EnableEvents = True
End Sub

最佳答案

月排行榜 / 总排行榜

高

2017-11-6 08:39

Sub 标杆()
Application.EnableEvents = False
   
            Dim ar, br()
            Dim i As Long, j As Long
            Dim qs As Date, jz As Date, sr As String
            Set my = Sheets("销售提成统计")
            With my
                qs = .Cells(1, 1): jz = .Cells(1, 3): sr = Cells(1, 4)
                ar = Sheets("汇总").Cells(3, 1).CurrentRegion
                For i = 1 To UBound(ar)
                    If Trim(ar(i, 11)) = Trim(sr) Then
                        j = j + 1
                        ReDim Preserve br(1 To 10, 1 To j)

                        br(1, j) = ar(i, 2)
                        br(2, j) = ar(i, 3)

                        br(3, j) = ar(i, 4)
                        br(4, j) = ar(i, 5)
                        br(5, j) = ar(i, 6)
                         br(6, j) = ar(i, 7)

                        br(7, j) = ar(i, 8)
                        br(8, j) = ar(i, 9)
                        br(9, j) = ar(i, 10)

                    End If
                Next i
                .Cells(10, 1).Resize(j, 10).ClearContents
                .Cells(10, 1).Resize(j, 10) = Application.Transpose(br)
            End With
     
    Application.EnableEvents = True
End Sub
改了第一行，删除3、4行两个if 行，删除最后两个end if
你自己插入一个按钮或图形，指定宏（为新起的宏的名字，可以是中文，可以是英文，不能是纯数字）

跳转到最佳答案楼层

高

Sub 标杆()
Application.EnableEvents = False
   
            Dim ar, br()
            Dim i As Long, j As Long
            Dim qs As Date, jz As Date, sr As String
            Set my = Sheets("销售提成统计")
            With my
                qs = .Cells(1, 1): jz = .Cells(1, 3): sr = Cells(1, 4)
                ar = Sheets("汇总").Cells(3, 1).CurrentRegion
                For i = 1 To UBound(ar)
                    If Trim(ar(i, 11)) = Trim(sr) Then
                        j = j + 1
                        ReDim Preserve br(1 To 10, 1 To j)

                        br(1, j) = ar(i, 2)
                        br(2, j) = ar(i, 3)

                        br(3, j) = ar(i, 4)
                        br(4, j) = ar(i, 5)
                        br(5, j) = ar(i, 6)
                         br(6, j) = ar(i, 7)

                        br(7, j) = ar(i, 8)
                        br(8, j) = ar(i, 9)
                        br(9, j) = ar(i, 10)

                    End If
                Next i
                .Cells(10, 1).Resize(j, 10).ClearContents
                .Cells(10, 1).Resize(j, 10) = Application.Transpose(br)
            End With
     
    Application.EnableEvents = True
End Sub
改了第一行，删除3、4行两个if 行，删除最后两个end if
你自己插入一个按钮或图形，指定宏（为新起的宏的名字，可以是中文，可以是英文，不能是纯数字）

wszsp

如果我不改代码，而是另外写一个宏来掉用Private Sub Worksheet_Change(ByVal Target As Range)
开始的宏。代码怎么写。
sub 掉用()
.....

end sub