数据校验和字符长度判断

哐哐~

“sheet1”的A列只能填“枚举选项”内的内容，B列限制了长度，只能填4个字符，英文和中文单个都算1个字符


数据非常多，求助如何才能实现 A列数据校验和 B列长度检验，如果不符则进行颜色标记
如图所示：



附件：
工作表.rar (4 KB, 下载次数: 37)

2016-4-18 19:47 上传

点击文件名下载附件

　

liulang0808

数据非常多，不知道多成什么程度的
枚举那个可以考虑字典的，但是需要看数据多少的
后面的长度，len就可以了

哐哐~

liulang0808 发表于 2016-4-18 19:54
数据非常多，不知道多成什么程度的
枚举那个可以考虑字典的，但是需要看数据多少的
后面的长度，len就可 ...

上千行，多列，多种枚举项
字典不会用，会部分数组，曾用过数组，但数据多，数据就执行慢且卡死

dyp1610

Sub ss()
Dim arr, myrow%
arr = Sheets("枚举选项").Range("A1").CurrentRegion
Sheet1.Activate
myrow = [A65536].End(xlUp).Row
For i = 2 To myrow
    If Len(Cells(i, 2)) > 4 Then Cells(i, 2).Font.Color = vbRed
    For j = 2 To UBound(arr)
        If Cells(i, 1) <> arr(j, 1) Then
            Cells(i, 1).Font.Color = vbRed
        Else
            Cells(i, 1).Font.Color = vbBlack
            Exit For
        End If
    Next
Next
End Sub

liulang0808

哐哐~ 发表于 2016-4-18 20:01
上千行，多列，多种枚举项
字典不会用，会部分数组，曾用过数组，但数据多，数据就执行慢且卡死

楼主在附件中，用模拟数据举例说明清楚吧
字典类似数组的

数据量少考虑使用find查找功能

哐哐~

liulang0808 发表于 2016-4-18 20:08
楼主在附件中，用模拟数据举例说明清楚吧
字典类似数组的

我已经 附件和截图都已经举例了啊
第6、11行不符合我描述的规则，我手动把字体标红了

liulang0808

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    Dim rng As Range
    Set d = CreateObject("scripting.dictionary")
    arr = Sheets("枚举选项").UsedRange
    For j = 2 To UBound(arr)
        d(arr(j, 1)) = ""
    Next j
    arr = [a1].CurrentRegion
   
    For j = 2 To UBound(arr)
        If Not d.exists(arr(j, 1)) Then
            If rng Is Nothing Then
                Set rng = Cells(j, 1)
            Else
                Set rng = Union(rng, Cells(j, 1))
            End If
        End If
        If Len(arr(j, 2)) > 4 Then
            If rng Is Nothing Then
                Set rng = Cells(j, 2)
            Else
                Set rng = Union(rng, Cells(j, 2))
            End If
        End If
    Next j
    If Not rng Is Nothing Then rng.Interior.Color = 2
    Application.ScreenUpdating = True
End Sub

liulang0808

针对目前附件内容，可以运行

哐哐~

liulang0808 发表于 2016-4-18 20:32
针对目前附件内容，可以运行

谢谢，测试是可以的，字典速度就是快，你的代码我逐句在本地窗口看，看懂一点点，看不懂的是变量Rng
其实A和B列是没有关系的，你最后是统一颜色了，我的想法是数据不对和长度不对 颜色分开的

liulang0808

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    Dim rng1 As Range
    Dim rng2 As Range
    Set d = CreateObject("scripting.dictionary")
    arr = Sheets("枚举选项").UsedRange
    For j = 2 To UBound(arr)
        d(arr(j, 1)) = ""
    Next j
    arr = [a1].CurrentRegion
   
    For j = 2 To UBound(arr)
        If Not d.exists(arr(j, 1)) Then
            If rng1 Is Nothing Then
                Set rng1 = Cells(j, 1)
            Else
                Set rng1 = Union(rng1, Cells(j, 1))
            End If
        End If
        If Len(arr(j, 2)) > 4 Then
            If rng2 Is Nothing Then
                Set rng2 = Cells(j, 2)
            Else
                Set rng2 = Union(rng2, Cells(j, 2))
            End If
        End If
    Next j
    If Not rng1 Is Nothing Then rng1.Interior.ColorIndex = 6
    If Not rng2 Is Nothing Then rng2.Interior.ColorIndex = 8
    Application.ScreenUpdating = True
End Sub