' 声明Sleep函数（兼容所有Excel版本）#If VBA7 Then Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)#Else Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)#End IfSub 闪灯特效() Dim wb As Workbook Dim sht As Worksheet Dim i As Integer Dim kx As String, sx As String Dim dt As Range Dim cell As Range Dim rat As Range, sd1 As Range, sd2 As Range kx = "□" sx = ChrW(&H2588) Set wb = ThisWorkbook Set sht = wb.Sheets(1) With sht .Activate .Columns("A:BG").ColumnWidth = 2 .Rows("2,5").EntireRow.AutoFit .Rows("3").EntireRow.Hidden = True .Cells.Interior.ThemeColor = xlThemeColorLight1 Set rat = .Range("A1:BG1,A4:BG4") Set sd1 = .Range("A2:BG2") Set sd2 = .Range("A5:BG5") Set dt = .Range("A2:BG2,A5:BG5") rat.Formula = "=RANDBETWEEN(1, 10)" sd1.Formula = "=REPT(""" & kx & """,10-A1)&REPT(""" & sx & """,A1)" sd2.Formula = "=REPT(""" & kx & """,10-A4)&REPT(""" & sx & """,A4)" .Calculate DoEvents dt.Orientation = xlVertical For Each cell In dt cell.Font.Color = RGB(Rnd() * 255, Rnd() * 255, Rnd() * 255) Next cell Application.ScreenUpdating = True For i = 1 To 500 .Calculate DoEvents Sleep 30 Next i End With Set wb = Nothing Set sht = Nothing Set dt = Nothing Set rat = Nothing Set sd1 = Nothing Set sd2 = NothingEnd Sub
