Excel -每行单元格区域仅允许1个条目

xsuvu9jc 于 11个月前发布在其他

关注(0)|答案(2)|浏览(112)

我有下面的代码工作正常，只允许一个条目存在于一行的一个范围内（即，B3：I3）。您如何扩展此代码以单独评估多行，而不必为每个新行复制，粘贴和调整此代码？换句话说，您如何确保B3：I3只允许1个条目; B4：I4只允许1个条目; B5：I5只允许1个条目;等等？

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

字符串
这段代码在单行上运行良好，但我希望它在多行上重复。

excel

来源：https://stackoverflow.com/questions/77399483/excel-allow-only-1-entry-per-row-cell-range

2条答案

按热度按时间

lsmepo6l1#

请试试看。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngCols As Range, rngCell As Range
    Dim rngRow As Range, vVal
    Set rngCols = Range("B:I")
    'is the changed cell in the Range to check
    If Not Intersect(Target, rngCols) Is Nothing Then
        If Target.Columns.Count = 1 Then
            'Did you enter something in that cell, or just clear it?
            For Each rngCell In Target.Cells
                vVal = rngCell.Value
                If Len(vVal) > 0 Then
                    'Don't trigger the event endlessly
                    Application.EnableEvents = False
                    Set rngRow = Intersect(rngCols, rngCell.EntireRow)
                    'make sure to not clear the cell we just changed
                    rngRow.ClearContents
                    rngCell.Value = vVal
                End If
            Next
        End If
    End If
    're-enable the event method
    Application.EnableEvents = True
End Sub

字符串

赞(0）回复(0）举报 11个月前

zlwx9yxi2#

你可能会在这之后（不太确定你的目标......）

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim watchedRng As Range
        Set watchedRng = Range("B3:I5") ' <-- set the range you want to ensure each row of which has only 1 value

        Dim sensibleRng As Range
            Set sensibleRng = Intersect(Target, watchedRng)

                If Not sensibleRng Is Nothing Then

                    Set sensibleRng = Intersect(sensibleRng.EntireRow, watchedRng)
                    Dim myRow As Range
                        For Each myRow In sensibleRng.Rows

                            If Application.WorksheetFunction.CountA(myRow) > 1 Then

                                    With Intersect(Target, myRow)
                                    
                                        Dim nValues As Long
                                            nValues = WorksheetFunction.CountA(.Cells)
                                            If nValues > 1 Then
                                                MsgBox "I don't know which of the new " & nValues & " values I have to preserve in row " & .row
                                            Else
                                            
                                                Dim val As Variant
                                                    val = .Value
                                                    
                                                    On Error GoTo SafeExit ' be sure you will be able to set Application.EnableEvents back True
                                                    Application.EnableEvents = False
                                                        myRow.ClearContents
                                                        Intersect(myRow, Target).Value = val
                                            
                                            End If
                                        
                                    End With                                        
                                        
                            End If

                        Next
        End If

SafeExit:
    Application.EnableEvents = True

End Sub

字符串

赞(0）回复(0）举报 11个月前

我来回答

Excel -每行单元格区域仅允许1个条目

2条答案

相关问题

热门标签

最新问答