区域超限提示

jx928867128

区域超限提示.rar (36.82 KB, 下载次数: 3)

2023-3-19 18:52 上传

点击文件名下载附件

gwjkkkkk

Option Explicit
Sub TEST()
    Dim ar(1 To 14, 1 To 3), br, i&, j&, m&, n&, k&, iColor&, t#
   
    DoApp False
    t = Timer
    Cells.Interior.ColorIndex = 0
   
    For i = 1 To UBound(ar)
        Set ar(i, 2) = CreateObject("Scripting.Dictionary")
        Set ar(i, 3) = Cells(8, (i - 1) * 9 + 2).Resize(29993).Resize(, 5)
        ar(i, 1) = ar(i, 3)
        For m = 1 To UBound(ar(i, 1))
            For n = 1 To UBound(ar(i, 1), 2)
                ar(i, 2)(ar(i, 1)(m, n)) = ""
            Next n
        Next m
    Next i
   
    br = Sheets(2).[A1].CurrentRegion
    For i = 2 To UBound(br)
        k = 0
        For j = 1 To UBound(ar)
            If ar(j, 2).exists(br(i, 1)) Then
                k = k + 1
            End If
        Next j
        If k > 0 And k <> br(i, 2) Then
           iColor = IIf(k > br(i, 2), 3, 47)
           For j = 1 To UBound(ar)
               For m = 1 To UBound(ar(i, 1))
                   For n = 1 To UBound(ar(i, 1), 2)
                       If ar(j, 1)(m, n) = br(i, 1) Then
                          ar(j, 3)(m, n).Interior.ColorIndex = iColor
                       End If
                   Next n
               Next m
           Next j
        End If
    Next i
   
    DoApp
    MsgBox "执行完毕!_用时:  " & Format(Timer - t, "0.00") & "  秒", 64
End Sub
Function DoApp(Optional b As Boolean = True)
    With Application
        .ScreenUpdating = b
        .DisplayAlerts = b
        .Calculation = -b * 30 - 4135
    End With
End Function

gwjkkkkk

请参考附件。。。

jx928867128

gwjkkkkk 发表于 2023-3-19 20:28
请参考附件。。。

谢谢老师的多次帮忙，再次谢谢，我用实际数据测试发现程序报错，结果也不对，麻烦您再帮我检查下好吗 区域超限提示，实际数据测试程序报错，结果也不正确.rar (51.74 KB, 下载次数: 2)

2023-3-19 21:24 上传

点击文件名下载附件

gwjkkkkk

jx928867128 发表于 2023-3-19 21:24
谢谢老师的多次帮忙，再次谢谢，我用实际数据测试发现程序报错，结果也不对，麻烦您再帮我检查下好吗

你用左上角按钮点击，我用的相对引用，直接在vbe运行未切换正确当前工用表会产生错误。

jx928867128

gwjkkkkk 发表于 2023-3-19 21:31
你用左上角按钮点击，我用的相对引用，直接在vbe运行未切换正确当前工用表会产生错误。

我就是用你那个按钮运行的

准提部林

比如样表中的B8到J30000就是第一个区域???

排課有到3万行???

gwjkkkkk

1.我看了下，代码有一点问题，已修改
2.但你教师区域限制有重复值（32行107行重复请自行处理）

jx928867128

gwjkkkkk 发表于 2023-3-19 22:58
1.我看了下，代码有一点问题，已修改
2.但你教师区域限制有重复值（32行107行重复请自行处理）

感谢老师的再次帮忙，万分感谢，祝您生活情快。

jx928867128

准提部林 发表于 2023-3-19 22:03
比如样表中的B8到J30000就是第一个区域???

排課有到3万行???

谢谢老师的多次帮忙，再次感谢，祝您生活愉快，实际用时并没有那个多，那个值只是我为了说明区域时写的一个值