隨細胞Interior.Color隨機變色

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

我認為不需要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

Answer 2

這對我來說很有用。 請注意您正在使用Wait功能，這會導致每個“幀”延遲3秒:)加快速度的方法是將延遲從3秒減少到1秒:)

但隨后顏色不會發生這么大變化，因為隨機數發生器是基於系統時間的，如果減少延遲，它的變化會更小。

您也可以使用函數Rnd()並將其乘以256而不是使用工作表函數。 但我不確定，它會顯着影響執行的持續時間。