Question

我拼凑了一些简单的东西，看看会发生什么，当然我打破了excel。

Sub colourChange()

    Dim r As Byte, g As Byte, b As Byte

    On Error Resume Next

    For l = 0 To 50
        For j = 1 To 22
            For k = 1 To 66
                r = WorksheetFunction.RandBetween(0, 255)
                g = WorksheetFunction.RandBetween(0, 255)
                b = WorksheetFunction.RandBetween(0, 255)
                Cells(j, k).Interior.Color = RGB(r, g, b)
            Next k
        Next j
        Application.Wait Now + #12:00:03 AM#
    Next l

End Sub

它开始很好，然后生物减速到虚拟停顿，最终甚至产生太多不同的单元格格式错误。

有什么办法可以加快速度并阻止错误吗？我查了一下，excel应该支持4000种不同的单元格格式，我不应该打到它的一半！它是否记得以前的那些什么？这里发生了什么？

Answer 1

对我来说效果很好。请注意您正在使用Wait功能，这会导致每个“帧”延迟3秒:)加快速度的方法是将延迟从3秒减少到1秒：）

但是颜色不会发生那么大的改变，因为随机数发生器是基于系统时间的，如果我们减少延迟，它的变化会更小。

您也可以使用函数Rnd()并将其乘以256而不是使用工作表函数。但我不确定，它会显着影响执行的持续时间。

Answer 2

我认为不需要l = 0到50。并且 Application.ScreenUpdating = False 设置有助于更快地练习。我猜Excel的内部颜色总数有限制。

Sub colourChange()

    Dim r As Byte, g As Byte, b As Byte
    Dim vR(), n As Integer
    'Cells.Clear
    n = 3000
    ReDim vR(1 To n)
    For i = 1 To n
        r = WorksheetFunction.RandBetween(0, 255)
        g = WorksheetFunction.RandBetween(0, 255)
        b = WorksheetFunction.RandBetween(0, 255)
        vR(i) = RGB(r, g, b)
    Next i
    Application.ScreenUpdating = False
        For j = 1 To 500
            For k = 1 To 100
                Cells(j, k).Interior.Color = vR(WorksheetFunction.RandBetween(1, n))

            Next k
        Next j
    Application.ScreenUpdating = True
End Sub

其他方式，首先练习子getColor（）（仅第一次）然后练习colourchang（）。

Public vR()
Public n As Integer
Sub getColor()
    Dim r As Byte, g As Byte, b As Byte
    Dim i As Integer
    'Cells.Clear
    n = 3000
    ReDim vR(1 To n)
    For i = 1 To n
        r = WorksheetFunction.RandBetween(0, 255)
        g = WorksheetFunction.RandBetween(0, 255)
        b = WorksheetFunction.RandBetween(0, 255)
        vR(i) = RGB(r, g, b)
    Next i

End Sub
Sub colourChange()
    Dim j As Integer, k As Integer, m As Integer
    Application.ScreenUpdating = False
        For j = 1 To 500
            For k = 1 To 100
                m = WorksheetFunction.RandBetween(1, n)
                Cells(j, k).Interior.Color = vR(m)
            Next k
        Next j
    Application.ScreenUpdating = True
End Sub

随细胞Interior.Color

2 个答案: