有办法像玩游戏一下，通过键盘的上下左右键控制单元格底色的移动吗？

wyft5t5

有办法像玩游戏一下，通过键盘的上下左右键控制单元格底色的移动吗？

如附件或截图所示，当我点击向下的箭头的时候，F5单元格下移，或者底色下移都可以。

一把小刀闯天下

'新建一个工作表

Option Explicit

Private Type pos
  x As Long
  y As Long
End Type

Dim lastcolor, p As pos

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  On Error GoTo errmsg
  If Target.Count > 1 Then Exit Sub
  With p
    If .x > 0 Then
      Target.Interior.Color = lastcolor
      Cells(.x, .y).Interior.ColorIndex = xlNone
      .x = Target.Row: .y = Target.Column
    Else
      Target.Interior.Color = vbRed: lastcolor = vbRed
      .x = Target.Row: .y = Target.Column
    End If
  End With
Exit Sub
errmsg:
End Sub

zpy2

是不是聚光灯啊？

wyft5t5

zpy2 发表于 2018-2-25 14:27
是不是聚光灯啊？

不是聚光灯，我其实是想做一个走迷宫的游戏来着

wyft5t5

一把小刀闯天下 发表于 2018-2-25 11:52
'新建一个工作表

Option Explicit

可不可以帮忙把例子发附件给我啊，这个没有调试成功

一把小刀闯天下

wyft5t5 发表于 2018-2-25 15:03
可不可以帮忙把例子发附件给我啊，这个没有调试成功

单元格颜色、内容随方向键移动.rar (33.5 KB, 下载次数: 5)

2018-2-25 16:42 上传

点击文件名下载附件

'修改了一下

Option Explicit

Private Type pos
  x As Long
  y As Long
End Type

Dim lastcolor, lastvalue, p As pos

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  On Error GoTo errmsg
  If Target.Count > 1 Then Exit Sub
  With p
    If .x > 0 Then
      Target.Interior.ColorIndex = lastcolor
      Target = lastvalue
      Cells(.x, .y).Interior.ColorIndex = xlNone
      Cells(.x, .y) = vbNullString
      .x = Target.Row: .y = Target.Column
    Else
      If Target.Interior.ColorIndex <> xlNone Or Len(Target) > 0 Then
        lastcolor = Target.Interior.ColorIndex
        lastvalue = Target
        .x = Target.Row: .y = Target.Column
      End If
    End If
  End With
Exit Sub
errmsg:
End Sub

Sub reset()
  p.x = 0
End Sub

一把小刀闯天下

wyft5t5 发表于 2018-2-25 15:03
可不可以帮忙把例子发附件给我啊，这个没有调试成功

单元格颜色、内容随方向键移动.rar (33.5 KB, 下载次数: 10)

2018-2-25 16:44 上传

点击文件名下载附件

再试一下

aman1516

试试：

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. On Error Resume Next
   
3. If Target.Count > 1 Then Exit Sub
   
4. If ActiveCell.Row < 2 And KeyCode = 38 Then Exit Sub
   
5. If ActiveCell.Column < 2 And KeyCode = 37 Then Exit Sub
   
6. Application.EnableEvents = False
   
7. Cells.Interior.ColorIndex = 0
   
8. With ActiveCell
   
9.      If KeyCode = 37 Then .Offset(0, -1).Select        '键盘 左 键
   
10.      If KeyCode = 38 Then .Offset(-1, 1).Select        '键盘 上 键
    
11.      If KeyCode = 39 Then .Offset(0, 0).Select         '键盘 右 键
    
12.      If KeyCode = 40 Then .Offset(1, 0).Select         '键盘 下 键
    
13. End With
    
14. Application.EnableEvents = True
    
15. Target.Interior.ColorIndex = 3
    
16. End Sub

复制代码

aman1516

见附件： 键盘移动单元格颜色.rar (11.76 KB, 下载次数: 13)

2018-2-26 00:34 上传

点击文件名下载附件

wyft5t5

一把小刀闯天下 发表于 2018-2-25 16:44
再试一下

谢谢，可以使用，我研究一下