为什么运行完这个代码后不能直接运行下一个代码

青青的河边草

为什么运行完这个代码后不能直接运行下一个代码

Private Sub CommandButton45_Click()

Application.ScreenUpdating = False

    y= [ae1] & "@" & [ae2] & "@" & [ae3] &"@" & [ae4]

   ar = Range("r8:r9000").Value

   For h = 1 To UBound(ar)

       If ar(h, 1) & "@" & ar(h + 1, 1) & "@"& ar(h + 2, 1) & "@" & ar(h + 3, 1) = y Then

           Cells(h + 7, 18).Resize(4, 1).Interior.ColorIndex = 6

       End If

       If h = 8990 Then: End

   Next h

Application.ScreenUpdating= True

Dim arr

ir = 28

Application.ScreenUpdating= False

For i = 18 To 24

'    Z = 1

    For j = Cells(Rows.Count, i).End(3).Row To4 Step -1

    If Cells(j, i).Interior.Color = vbYellowAnd Cells(j - 3, i).Interior.Color = vbYellow Then

'        If Z > 1 Then

            If j >= 11 Then

                Cells(j - 11,i).Resize(21).Copy Cells(8, r)

                r = r + 1

            End If

'        End If

        Z = Z + 1

    End If

    Next

Next i

Application.ScreenUpdating= True

End Sub

青青的河边草

请路过的大师给予解决，谢谢。

microyip

感觉不是不运行，而是i、j两个取值引起吧？你F8一步步执行，看看为什么不执行就知道啦

青青的河边草

microyip 发表于 2019-11-9 07:47
感觉不是不运行，而是i、j两个取值引起吧？你F8一步步执行，看看为什么不执行就知道啦

例：点击自动，只能运行"r列上色"代码，不能自动运行"到ab8-17"代码，但手动又可以，不知怎么回事？

liulang0808

If h = 8990 Then: End
这个exit sub是否合适？

青青的河边草

liulang0808 发表于 2019-11-9 20:26
If h = 8990 Then: End
这个exit sub是否合适？

r列上色按钮代码的原文是：在AE1--AE4单元格中分别输入4个数字，点击按钮，若R8--R9000范围内有4个连续单元格内数排列及内容与AE1--AE4单元格内数一样，那么这4个单元格显黄色。
怎么修改？

liulang0808

青青的河边草 发表于 2019-11-9 20:42
r列上色按钮代码的原文是：在AE1--AE4单元格中分别输入4个数字，点击按钮，若R8--R9000范围内有4个连续单 ...

R8--R9000对这个区域从上往下遍历，判断是否与AE1相同，如果相同再往下注意核对3跟数值是否与AE2,AE3,AE4相同即可

青青的河边草

liulang0808 发表于 2019-11-9 20:45
R8--R9000对这个区域从上往下遍历，判断是否与AE1相同，如果相同再往下注意核对3跟数值是否与AE2,AE3,AE4 ...

您帮忙改下代码行吗？

liulang0808

    brr = [ae1:ae4]
    arr = [R1:R9000]
    For j = 8 To UBound(arr) - 3
        If arr(j, 1) = brr(1, 1) Then
            For i = 1 To 3
                If arr(j + i, 1) <> brr(i + 1, 1) Then GoTo l1
            Next i
            Cells(j, 1).Resize(4).Interior.ColorIndex = 3
        End If
l1:
    Next j
代码未测试，楼主参考吧

青青的河边草

liulang0808 发表于 2019-11-9 21:03
brr = [ae1:ae4]
    arr = [R1:R9000]
    For j = 8 To UBound(arr) - 3

没有变黄色