隨機顏色隨着細胞的變化而變化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

它很適合我。請注意您正在使用Wait函數，這會導致每個「幀」延遲3秒）。加速它的方法是將延遲從3秒減少到1秒:)

但是，因爲隨機數發生器是基於系統時間的，並且如果我們減少延遲，它會變少。

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

Answer 2

我認爲l = 0到50不需要。 而Application.ScreenUpdating =假設置幫助練習更快。 我猜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