[已解决]VBA ，方形转盘

QCW911

区域 发表于 2016-6-14 06:21
大神！麻烦告诉col.add.cells(5,i)是什么意思？？

Collection 是个集合
col.add.cells(5,i) 向集合添加单元格

zjdh

采用“集合”处理，学习了。

QCW911

grf1973 发表于 2016-6-13 17:06
代码简化一点：

'字典遍历获取[H5:L9]里面的地址   
For Each rng In [H5:L9]
        d(rng.Value) = rng.Address
Next
'为什么 Range(d(i)).Select 会按照范围的最外环选取呢？ 不理解
   For k = 1 To 3   
        For i = 1 To 16
            Range(d(i)).Select
            Sleep 50
        Next
    Next
’遍历取得时候是按照这样的顺序
$H$5
$I$5
$J$5
$K$5
$L$5
$H$6
$I$6
$J$6
$K$6
$L$6
$H$7
$I$7
$J$7
$K$7
$L$7
$H$8
$I$8
$J$8
$K$8
$L$8
$H$9
$I$9
$J$9
$K$9
$L$9
取出的时候为什么是
$H$5
$I$5
$J$5
$K$5
$L$5
$L$6
$L$7
$L$8
$L$9
$K$9
$J$9
$I$9
$H$9
$H$8
$H$7
$H$6
$H$5
$I$5
$J$5
$K$5
$L$5
$L$6
$L$7
$L$8
$L$9
$K$9
$J$9
$I$9
$H$9
$H$8
$H$7
$H$6

grf1973

For Each rng In [H5:L9]
        d(rng.Value) = rng.Address
Next
是把[H5:L9]区域里所有的地址全部记录下来了，并建立值跟地址的一一对应关系。d(1)=h5,d(2)=i5.....
我调用的时候只调用i=1 to 16的部分，即外圈单元格内容为数字的部分。

区域

grf1973 发表于 2016-6-14 10:09
For Each rng In [H5:L9]
        d(rng.Value) = rng.Address
Next

大神，如果不用延迟，只是单纯的使用IF语句和For，可不可以实现？
         不要用集合函数或者数组或者定义地址之类的函数

爱疯

around.rar (11.25 KB, 下载次数: 21)

2016-6-14 11:49 上传

点击文件名下载附件


Sub around()
    Dim rng As Range, temp As Range
    Dim top(), arr()
    Dim n, i, j, k, u, pos
    Cells.Clear

    Set rng = [a1]    '起点
    Set temp = rng
    n = 5    '边长
    top = [{0,1;1,0;0,-1;-1,0}]    '往右、往下、往左、往上
    ReDim arr(1 To n ^ 2 - (n - 2) ^ 2, 1 To 2): u = UBound(arr)

    '用二维数组arr，记录外围上所有的行号和列号。
    For i = 1 To 4              '遍历4边
        For j = 2 To n          '移动n-1
            Set temp = temp.Offset(top(i, 1), top(i, 2))    '修改方向
            temp.Borders.LineStyle = 1
            k = k + 1
            arr(k, 1) = temp.Row
            arr(k, 2) = temp.Column
        Next j
    Next i

    Randomize
    j = Int(u * Rnd + 1)    '从1到Bound(arr)中，随机选择一个数，作为起点
    k = u * 2 + Int(u * Rnd + 1)   '至少转2圈，再加一个随机数，作为终点

    '从起点j到终点k
    For i = j To k
        rng.Resize(n, n).Interior.ColorIndex = xlNone
        pos = IIf(i Mod u, i Mod u, u)    'arr的指针
        Cells(arr(pos, 1), arr(pos, 2)).Interior.ColorIndex = IIf(i = k, 4, 6)    'pos对应的单元格
        ting i * 0.002    '执行渐慢的延时
    Next i

End Sub

Sub ting(x)    '暂停
    Dim t
    t = Timer
    Do Until Timer - t > x
        VBA.DoEvents
    Loop
End Sub

区域

爱疯 发表于 2016-6-14 11:50
Sub around()
    Dim rng As Range, temp As Range
    Dim top(), arr()

Sub 跑马灯()

s = Int((16 * Rnd))

Range("A4") = s

k = s Mod 16

For j = 1 To 3

For i = 0 To 15

Range("D5:H9").Interior.Pattern = xlNone

If i <= 3 Then

Range("D5").Offset(0, i).Interior.Color = 65535

Call delay(0.1)

Else

If i > 3 And i <= 7 Then
  
  Range("H5").Offset(i - 4, 0).Interior.Color = 65535
  Call delay(0.1)
  
   Else
   
    If i > 7 And i <= 11 Then
    Range("H9").Offset(0, 8 - i).Interior.Color = 65535
    Call delay(0.1)
      
    Else
      
       If i > 11 And i <= 15 Then
      
        
      Range("D9").Offset(12 - i, 0).Interior.Color = 65535
      Call delay(0.1)
      
      
      End If                                                                                                                                                                         

      End If
      End If
      
      
End If
      
Next

Next

For T = 0 To k


Range("D5:H9").Interior.Pattern = xlNone

If T <= 3 Then

Range("D5").Offset(0, T).Interior.Color = 65535
Call delay(0.1)

Else

If T > 3 And T <= 7 Then

  Range("H5").Offset(T - 4, 0).Interior.Color = 65535
  Call delay(0.1)

   Else

    If T > 7 And T <= 11 Then

    Range("H9").Offset(0, 8 - T).Interior.Color = 65535
    Call delay(0.1)

    Else

       If T > 11 And T <= 15 Then


      Range("D9").Offset(12 - T, 0).Interior.Color = 65535
      Call delay(0.1)


      End If
      End If
      End If

End If

Next


End Sub

Sub delay(T As Single)
     Dim time1 As Single
     time1 = Timer
     Do
         DoEvents
     Loop While Timer - time1 < T
End Sub
根据这个代码实现的功能，请问大神们，可不可以让其实现随机旋转，不是固定的三圈，同时还能实现自动暂停及报数

02761752696

谢谢     分享