如何扩展Excel VBA代码实现每行仅允许单个单元格输入？

需求说明 #

现有VBA代码可实现单行单元格区域（如B3:I3）仅允许单个单元格输入内容，需要扩展该代码，使其支持对多行（如B3:I3、B4:I4、B5:I5等）分别进行判断，无需重复复制修改代码。

原始代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rg As Range
    Dim c As Range
    
Set rg = Range("B3:I3")

'is the changed cell in the Range to check
If Not Intersect(Target, rg) Is Nothing Then

'Did you enter something in that cell, or just clear it?
    If Len(Target) > 0 Then
    
'Don't trigger the event endlessly
        Application.EnableEvents = False
        For Each c In rg
        
'make sure to not clear the cell we just changed
            If Intersect(c, Target) Is Nothing Then c.ClearContents
        Next c
    End If
End If

're-enable the event method
Application.EnableEvents = True
        
End Sub

扩展后的代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rg As Range
    Dim currentRow As Range
    Dim c As Range
    
    '定义需要限制的多行区域，可根据实际需求调整范围
    Set rg = Range("B3:I5")
    
    '判断修改的单元格是否在目标区域内
    If Not Intersect(Target, rg) Is Nothing Then
        '仅当输入内容不为空时执行清除逻辑
        If Len(Target.Value) > 0 Then
            '获取当前修改单元格所在行在目标区域内的部分
            Set currentRow = Intersect(Target.EntireRow, rg)
            
            '关闭事件触发，避免循环执行
            Application.EnableEvents = False
            
            '遍历当前行的所有单元格，清除除当前修改单元格外的内容
            For Each c In currentRow
                If Not Intersect(c, Target) Is Nothing Then
                    '跳过当前修改的单元格
                    Continue For
                End If
                c.ClearContents
            Next c
        End If
    End If
    
    '重新开启事件触发
    Application.EnableEvents = True
End Sub

关键改动说明 #

• 目标区域定义：将单行范围Range("B3:I3")改为多行范围（如Range("B3:I5")），可根据实际需要调整行数和列数。
• 获取当前行：通过Intersect(Target.EntireRow, rg)定位到修改单元格所在的行在目标区域内的部分，确保只处理当前行，而非整个目标区域。
• 遍历逻辑优化：仅遍历当前行的单元格，清除除了Target之外的内容，实现每行独立判断。

内容的提问来源于stack exchange，提问作者Keebo