[已解决]出现不连续输入某个数值时禁止输入

longchaowu

各位大神，能否帮个忙用VBA实现，就是如图片所示，第一次在A列输入某个数值时，只要是连续输入，这个数值允许重复输入。当再次输入这个值时，如果与第一次输入的这个值出现了断行，不连续时，后续所有的这个值都需要被禁止输入，谢谢！ help.rar (41.14 KB, 下载次数: 4)

2016-5-7 18:59 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

爱疯

2016-5-8 12:37

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 And Target.Count = 1 Then
        '如果不连续
        If isContinuity(Target) = False Then
            '如果重复了
            If isRepeated(Target) = True Then
                '清除当前值
                Application.EnableEvents = False
                Target.ClearContents
                Application.EnableEvents = True
            End If
        End If
    End If
End Sub

'条件1：是否连续
Function isContinuity(Target As Range) As Boolean
    Dim area As Range
    Dim f As Long
    f = firstRow(Target)
    '从该值第1次出现的行号，到当前行
    Set area = Range(Cells(f, Target.Column), Target)
    isContinuity = Application.CountIf(area, Target) = Target.Row - f + 1
End Function

'条件2：是否重复
Function isRepeated(Target As Range) As Boolean
    Dim area As Range
    '如果当前是第1行，则不重复
    If Target.Row = 1 Then isRepeated = False: Exit Function
    '从该值第1次出现的行号，到当前行
    Set area = Range(Cells(firstRow(Target), Target.Column), Target)
    isRepeated = Application.CountIf(area, Target) > 1
End Function

'获取该值的第1次出现的行号
Function firstRow(Target As Range) As Long
    Dim rng As Range
    Set rng = Columns(Target.Column).Find(Target)
    If rng Is Nothing Then firstRow = Target.Row Else firstRow = rng.Row
End Function

help3.rar (87.21 KB, 下载次数: 9)

2016-5-8 12:37 上传

点击文件名下载附件

跳转到最佳答案楼层

爱疯

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 And Target.Count = 1 Then
        '如果不连续
        If isContinuity(Target) = False Then
            '如果重复了
            If isRepeated(Target) = True Then
                '清除当前值
                Application.EnableEvents = False
                Target.ClearContents
                Application.EnableEvents = True
            End If
        End If
    End If
End Sub

'条件1：是否连续
Function isContinuity(Target As Range) As Boolean
    Dim rng As Range
    '从该值第1次出现的行号，到当前行号
    Set rng = Range(Cells(getFirstRow(Target), Target.Column), Target)
    '如果区域无空白单元格，表示是连续的
    isContinuity = Application.CountBlank(rng) = 0
End Function

'条件2：是否重复
Function isRepeated(Target As Range) As Boolean
    Dim rng As Range
    '如果当前是第1行，则不重复
    If Target.Row = 1 Then isRepeated = False: Exit Function
    '从该值第1次出现的行号，到当前行的上一行
    Set rng = Range(Cells(getFirstRow(Target), Target.Column), Target.Offset(-1, 0))
    isRepeated = Application.CountIf(rng, Target) > 1
End Function

'获取该值的第1次出现的行号
Function getFirstRow(Target As Range)
    Dim rng As Range
    Set rng = Columns(Target.Column).Find(Target)
    If rng Is Nothing Then getFirstRow = Target.Row Else getFirstRow = rng.Row
End Function


help2.rar (45.99 KB, 下载次数: 5)

2016-5-7 22:48 上传

点击文件名下载附件



暂时好像可以。
挺绕人，写多了的感觉

longchaowu

爱疯 发表于 2016-5-7 22:49
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

多谢版主的鼎力相助，实现了我想要的功能

longchaowu

爱疯 发表于 2016-5-7 22:49
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

版主大神，刚才在用时发现了两个问题，是我没说清楚，望帮我完善一下，非常感谢！
help2.rar (87.08 KB, 下载次数: 5)

2016-5-8 10:23 上传

点击文件名下载附件

爱疯

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 And Target.Count = 1 Then
        '如果不连续
        If isContinuity(Target) = False Then
            '如果重复了
            If isRepeated(Target) = True Then
                '清除当前值
                Application.EnableEvents = False
                Target.ClearContents
                Application.EnableEvents = True
            End If
        End If
    End If
End Sub

'条件1：是否连续
Function isContinuity(Target As Range) As Boolean
    Dim area As Range
    Dim f As Long
    f = firstRow(Target)
    '从该值第1次出现的行号，到当前行
    Set area = Range(Cells(f, Target.Column), Target)
    isContinuity = Application.CountIf(area, Target) = Target.Row - f + 1
End Function

'条件2：是否重复
Function isRepeated(Target As Range) As Boolean
    Dim area As Range
    '如果当前是第1行，则不重复
    If Target.Row = 1 Then isRepeated = False: Exit Function
    '从该值第1次出现的行号，到当前行
    Set area = Range(Cells(firstRow(Target), Target.Column), Target)
    isRepeated = Application.CountIf(area, Target) > 1
End Function

'获取该值的第1次出现的行号
Function firstRow(Target As Range) As Long
    Dim rng As Range
    Set rng = Columns(Target.Column).Find(Target)
    If rng Is Nothing Then firstRow = Target.Row Else firstRow = rng.Row
End Function

help3.rar (87.21 KB, 下载次数: 9)

2016-5-8 12:37 上传

点击文件名下载附件

longchaowu

爱疯 发表于 2016-5-8 12:37
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

完美解决，感激不尽！！！