[已解决]【求助】修改宏，让宏从第333行以后开始计算

xdwy81129

该宏如下，学生改了多少都不成功，请老师赐教了，我真的改不了，感谢感谢感谢。

 

Sub 标注颜色444()
Application.ScreenUpdating = False
    Dim ARR2
    R = Range("B65536").End(xlUp).Row
    Arr1 = Range("O2:W" & R)
        For j = 1 To 9
        If j <> 5 Then
            '重新定义每列数组
            S = 0
            For i = 1 To UBound(Arr1, 1)
                If Arr1(i, j) <> "" Then
                    S = S + 1
                    If S = 1 Then
                        ReDim ARR2(1 To 3, 1 To 1)
                        ARR2(1, S) = i
                        ARR2(2, S) = Arr1(i, j)
                    Else
                        ReDim Preserve ARR2(1 To 3, 1 To S)
                        ARR2(1, S) = i
                        ARR2(2, S) = Arr1(i, j)
                    End If
                End If
            Next i
          '判断第一种情况
            Y = 1
            W = 1
            For i = 2 To UBound(ARR2, 2)
                If ARR2(2, i - 1) = ARR2(2, i) Then
                    Y = Y + 1
                    W = 1
                Else
                    Y = 1
                    W = W + 1
                End If
                           
                '写入第一种情况颜色
                If Y = 2 Then
                    ARR2(3, i) = 20
                    ARR2(3, i - 1) = 20
                End If
               
                If Y = 3 Then
                    ARR2(3, i) = 33
                    ARR2(3, i - 1) = 33
                    ARR2(3, i - 2) = 33
                End If
               
                If Y >= 4 Then
                    For L = 1 To Y
                        ARR2(3, i - L + 1) = 38
                    Next L
                End If
               '判断第二种情况
                If i >= 5 Then
                    T = True
                    For P = i - 4 To i - 1
                        For V = P + 1 To i
                            If ARR2(2, P) = ARR2(2, V) Then T = False
                        Next V
                    Next P
                    If T = True Then
                        For P = i - 1 To i
                            ARR2(3, P) = 3
                        Next P
                    End If
                End If

            Next i
            '标注颜色
            For i = 1 To UBound(ARR2, 2)
                Cells(ARR2(1, i) + 1, 14 + j).Interior.ColorIndex = ARR2(3, i)
            Next i
        End If
    Next j
        Application.ScreenUpdating = True
End Sub

[此贴子已经被作者于2009-9-22 23:32:13编辑过]

最佳答案

月排行榜 / 总排行榜

函数小菜鸟

2009-9-22 23:48

Cells(ARR2(1, i) + 321, 14 + j).Interior.ColorIndex = ARR2(3, i)

跳转到最佳答案楼层

雨狐

这个表你已经问了N次了,太长看得头晕,最好找帮你写的人解决

xdwy81129

呀，这是沧海老师写的了，希望是老师都帮下了。

函数小菜鸟

Arr1 = Range("O2:W" & R)

改成  Arr1 = Range("O322:W" & R)

xdwy81129

QUOTE:

以下是引用函数小菜鸟在2009-9-22 23:44:00的发言：

Arr1 = Range("O2:W" & R)

改成  Arr1 = Range("O322:W" & R)

我这样改过的，不行，颜色在一开始就出现了

函数小菜鸟

Cells(ARR2(1, i) + 321, 14 + j).Interior.ColorIndex = ARR2(3, i)

雨狐

好像要改这里

For i = 1 To UBound(ARR2, 2)
                Cells(ARR2(1, i) + 1, 14 + j).Interior.ColorIndex = ARR2(3, i)
            Next i
        End If
    Next j

zsd5237

For i = 2 To UBound(ARR2, 2)出现类型不匹配？