移动彩色细胞

是否可以循环一个单元格（即彩色可以说是红色）从A1到I1来回移动？

我试图简单地logging它，但它移动得太快，而macros运行时，我不能做任何事情，如写…

Answer 1

这里是如何移动你的“汽车”的基本演示，该button链接到StartGame 。 文件可以在这里下载

将此代码粘贴到模块中

 Dim i As Long, j As Long, k As Long Dim ws As Worksheet Dim r As Range Sub StartGame() Set ws = ThisWorkbook.Sheets("Sheet1") i = 1: j = 1: k = 1 MoveCar1 End Sub Sub MoveCar1() With ws Set r = .Cells(6, i) r.Cut r.Offset(, 2).Insert Shift:=xlToRight i = i + 1 End With Wait 1 MoveCar2 End Sub Sub MoveCar2() With ws Set r = .Cells(6, i) r.Cut r.Offset(, 2).Insert Shift:=xlToRight i = i + 1 Set r = .Cells(8, j) r.Cut r.Offset(, 2).Insert Shift:=xlToRight j = j + 1 End With Wait 1 MoveCar3 End Sub Sub MoveCar3() With ws Set r = .Cells(6, i) r.Cut r.Offset(, 2).Insert Shift:=xlToRight i = i + 1 Set r = .Cells(8, j) r.Cut r.Offset(, 2).Insert Shift:=xlToRight j = j + 1 Set r = .Cells(10, k) r.Cut r.Offset(, 2).Insert Shift:=xlToRight k = k + 1 End With Wait 1 MoveAllCars End Sub Sub MoveAllCars() For l = 1 To 8 With ws If i < 9 Then Set r = .Cells(6, i) r.Cut r.Offset(, 2).Insert Shift:=xlToRight i = i + 1 End If If j < 9 Then Set r = .Cells(8, j) r.Cut r.Offset(, 2).Insert Shift:=xlToRight j = j + 1 End If If k < 9 Then Set r = .Cells(10, k) r.Cut r.Offset(, 2).Insert Shift:=xlToRight k = k + 1 End If Wait 1 If i > 8 And j > 8 And k > 8 Then Exit For End With Next l End Sub Private Sub Wait(ByVal nSec As Long) nSec = nSec + Timer While nSec > Timer DoEvents Wend End Sub 

截图

Answer 2

考虑一下：

 Sub MyGame() Dim A As Range, I As Range, T As Date Dim T30 As Date Set A = Range("A1") Set I = Range("I1") A.Interior.ColorIndex = 3 T = Now T30 = T + TimeSerial(0, 0, 5) While Now < T30 DoEvents If A.Interior.ColorIndex = 3 Then A.Interior.ColorIndex = xlNone I.Interior.ColorIndex = 3 Else A.Interior.ColorIndex = 3 I.Interior.ColorIndex = xlNone End If Wend End Sub 

它会将单元格A1着色为红色，然后在A1和I1之间来回移动该颜色大约10秒钟。