程序太大vba for excel

Question

我不习惯编写代码.我通常通过宏生成我的代码,我正面临这个问题.有人可以帮帮我吗？

Sub Test()

    Dim WorkRng As Range
    Dim Rng As Range
    Dim xOffsetColumn As Integer

    Set WorkRng = Intersect(Application.ActiveSheet.Range("B8:B38"), Target)
    xOffsetColumn = 19

    If Not WorkRng Is Nothing Then
        Application.EnableEvents = False

        For Each Rng In WorkRng
            If Not VBA.IsEmpty(Rng.Value) Then
                Rng.Offset(0, xOffsetColumn).Value = Now
                Rng.Offset(0, xOffsetColumn).NumberFormat = "mm/dd/yyyy, hh:mm:ss"
            Else
                Rng.Offset(0, xOffsetColumn).ClearContents
            End If
        Next

        Application.EnableEvents = True
    End If

    Dim WorkRng1 As Range
    Dim Rng1 As Range
    Dim xOffsetColumn1 As Integer

    Set WorkRng1 = Intersect(Application.ActiveSheet.Range("C8:C38"), Target)
    xOffsetColumn1 = 18

    If Not WorkRng1 Is Nothing Then

        For Each Rng1 In WorkRng1
            If Not VBA.IsEmpty(Rng1.Value) Then
                Rng1.Offset(0, xOffsetColumn1).Value = Now
                Rng1.Offset(0, xOffsetColumn1).NumberFormat = "mm/dd/yyyy, hh:mm:ss"
            Else
                Rng1.Offset(0, xOffsetColumn1).ClearContents
            End If
        Next

        Application.EnableEvents = True
    End If

    ....................................
    ..............................

    Dim WorkRng132 As Range
    Dim Rng132 As Range
    Dim xOffsetColumn132 As Integer

    Set WorkRng132 = Intersect(Application.ActiveSheet.Range("EJ8:EJ38"), Target)
    xOffsetColumn132 = 1

    If Not WorkRng132 Is Nothing Then

        For Each Rng132 In WorkRng132
            If Not VBA.IsEmpty(Rng132.Value) Then
                Rng132.Offset(0, xOffsetColumn132).Value = Now
                Rng132.Offset(0, xOffsetColumn132).NumberFormat = "mm/dd/yyyy, hh:mm:ss"
            Else
                Rng132.Offset(0, xOffsetColumn132).ClearContents
            End If
        Next

        Application.EnableEvents = True
    End If

End Sub

Answer 1

编程中一个有用的格言是" 不要重复自己"(DRY) - 重复的代码更长,更难理解,难以维护.

代码中有一个清晰的重复模式.这个块:

Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer

Set WorkRng = Intersect(Application.ActiveSheet.Range("B8:B38"), Target)
xOffsetColumn = 19

If Not WorkRng Is Nothing Then
    Application.EnableEvents = False

    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = Now
            Rng.Offset(0, xOffsetColumn).NumberFormat = "mm/dd/yyyy, hh:mm:ss"
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next

    Application.EnableEvents = True
End If

可以使用两个参数重构为可重用的方法:

Sub Test()
    '....
    ProcessRange Application.Intersect(Me.Range("B8:B38"), Target), 19
    ProcessRange Application.Intersect(Me.Range("C8:C38"), Target), 18
    'etc for the other ranges
    '....
End sub


'subprocedure
Sub ProcessRange(WorkRng As Range, offsetCol as Long)
    Dim Rng As Range
    If Not WorkRng Is Nothing Then
        Application.EnableEvents = False
        For Each Rng In WorkRng
            With Rng.Offset(0, offsetCol)
            If Not VBA.IsEmpty(Rng.Value) Then
                .Value = Now
                .NumberFormat = "mm/dd/yyyy, hh:mm:ss"
            Else
                .ClearContents
            End If
            End With
        Next
        Application.EnableEvents = True
    End If

End Sub