时间戳

首页 > 解决方案 > 如何合并重复的 VBA 代码？

excel - 如何合并重复的 VBA 代码？

问题描述

我是编写 VBA 的新手，并且一直在通过堆栈溢出来完成我迄今为止所需要的。我编写的代码对我来说很好，但其他人似乎遇到了编译问题。我把代码缩小了（实际字符串中有 1204 个过程，不用说，很多）。

我正在寻求帮助以巩固我所写的内容。请您看一下并推荐一种缩小此代码以减轻冗余的好方法吗？

感谢您的帮助！

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim c&, i&, k, v, col
  
  DoEvents
  ReDim v(1 To 1224, 1 To 2)
  
  For i = 1 To 102
    v(i, 1) = "O" & 6 + i
    Select Case i
        Case Is <= 70
            v(i, 2) = "=A"
        Case Is <= 100
            v(i, 2) = "=B"
        Case Else
            v(i, 2) = "=D"
    End Select
  Next i

  For i = 103 To 204
    v(i, 1) = "T" & 6 + i
    Select Case i
        Case Is <= 172
            v(i, 2) = "=A"
        Case Is <= 202
            v(i, 2) = "=B"
        Case Else
            v(i, 2) = "=D"
    End Select
  Next i

  For i = 205 To 306
    v(i, 1) = "Y" & 6 + i
    Select Case i
        Case Is <= 274
            v(i, 2) = "=A"
        Case Is <= 304
            v(i, 2) = "=B"
        Case Else
            v(i, 2) = "=D"
    End Select
  Next i
  
  With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    For i = 1 To UBound(v)
      With Range(v(i, 1))
        If Not Intersect(Target, .Cells) Is Nothing Then
            If Len(.Value2) = 0 Then
            .Formula = v(i, 2)
          End If
        End If
      End With
    Next
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
  End With
  
  
End Sub

标签： excelvba

解决方案

像这样的东西应该工作

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim i As Long, c As Range, f
    
    On Error GoTo haveError
    Application.EnableEvents = False
    
    For Each c In Target.Cells     'loop over Target cells
        For i = 15 To 70 Step 5    'check each column from O to BR
            If Not Application.Intersect(c, Me.Range(Me.Cells(7, i), Me.Cells(109, i))) Is Nothing Then
                'Target cell is in the column range...
                If Len(c.Value) = 0 and c.Row <> 35 Then
                    Select Case c.Row
                        Case 7 To 77: f = "=A"
                        Case 78 To 107: f = "=B"
                        Case Else: f = "=D"
                    End Select
                    c.Formula2 = f 'this formula seems incomplete though?
                End If
            End If
            Exit For 'stop checking for this cell 
        Next i
    Next c
    
'ensure events not left off in the event of an error
haveError:
    Application.EnableEvents = True
  
End Sub

推荐阅读