Excel下2048的实现

环境：

office 2013

win7 64位

初学VBA，做了个东西自娱自乐，顺便在这记录下，而且，原版没认真研究喔，希望大家不要喷...

本文顺序：

核心算法逻辑分析以及代码实现

excel设置准备

此版本的逻辑分析

试玩

正文：

1.核心算法逻辑分析以及代码实现

1.1算法逻辑分析

以上图为例，从第一行分析：

从右往左移动的时候（只分析第一行），现在只考虑位置移动时的各种情况，并把B下64的位置叫左B，C下8的位置叫C，D下8的位置叫D，E下16的位置叫E：右往左移动时，整体的移动顺序为：

C移动到B后，D再从到C到B，最后E到D到C到B。

每次移动时，如果（相邻位置指BC,CD,DE，因为每次移动都可以拆分成相邻的移动。如D到C到B，先是D到C移动，再）：

（1）相邻位置的值都不为0且相等时，那么左边的值乘以2，右边的值清零（清零是为了符合第三条规律）；

（2）相邻位置都不为0且数值不相等时，不移动；

（3）相邻位置左边为0，右边不为0时，右边的值给左边（记住是右往左滑动），右边的值清零（其实也可以认为是左右的值互换）；

其他情况都不需要进行移动和值的更改，比如相邻都是0；相邻时左边不为0，右边为0；相邻左右都不为零且都不相等，等等。

颜色的话在数值改变的同时更改就好了，人为的设定好了每个数值对应什么颜色。

以上面的第一行从右往左为例：

先是C移动到B：

由于B和C都不为零且都不相等，所以不需要移动，这时BCDE的数值为(由于对位问题，加-以示间隔)：

B----C----D----E

64---8----8----16

接着D到C到B：

先分析D到C，大家都是8，符合第一种情况，于是C的值变为16（颜色也改变，颜色改变下文不再重复叙述，只要格子的值有变化（无论是0到非零，非零到0，当前值乘以2，等等），都会进行对应的颜色设置），D的值改变为0，这时BCDE的值为(由于对位问题，加-以示间隔)：

B----C----D----E

64---16---0----16

然后C到B进行判断BC都不为零且不相等，不需要移动，这时BCDE的值为(由于对位问题，加-以示间隔)：

B----C----D----E

64---16---0---16

最后就E到D到C到B的移动了(由于对位问题，加-以示间隔)：

先是E到D，符合第三种情况：左边为0，右边不为零0，D的值给C后，D清0，这时BCDE的值为：

B----C----D----E

64---16--16--0

然后D到C判断，符合第一种情况，于是C的值乘以2，D清零，这时BCDE的值为：

B----C----D----E

64---32---0----0

接着判断C到B，左右不为0且不相等，不用移动，最终BCDE的值为：

B----C----D----E

64---32---0----0

以上只是分析了第一行，其他三行如此类推。

以上只是分析了从右往左移动时的情况，其他方向如此类推。

1.2代码实现

上面说的这里再总结一下，先是黎近的目标（如上面的C到B）先移动，接着远一点的逐个移动判断，接着再远一点的逐个移动到目标，逐个判断。然后这是其中的一行，其他三行如法炮制。

代码还是以右往左为例

For k = 0 To 3kLoop = k * 3 + 1For j = 0 To 2For i = 0 To jcur = j + 3 - ipre = j + 2 - iCall gameRunLeftAndRight(kLoop, cur, pre)NextNext
Next

这里用了3层for-next循环，先分析最中间的for j = 0 to 2分析（稍微普及基础：VBA是从j等于0开始，每循环一次j会加1，然后一直到j大于2才结束循环，0到2就是循环3次了），就是对于上面的C到B，D到C到B，E到D到C到B的3次大的移动。

然后每次移动，又可以这样分为小的移动：j为0时，C到B，移动1次；j为1时，D到C，C到B，共2次；j为2时，E到D，D到C，C到B，共3次；

是不是发现点小规律了？j为0时移动1次，为1时移动2次，为2时移动3次，于是就有了最里面的for i = 0 to j 的循环。（j为0时，i的取值是0到0，也就是执行1次；j为1时，i的取值是0到1，共2次；j为2的时候i的取值为0到2，共3次。）

最外层的for k = 0 to 3就是对每一行进行循环了，每一次对应一行进行判断。

判断的逻辑在最里面的for i 里进行即可。

先提及一下基础，如上图B下64的位置，是把原来的B1：B3的格进行了合并，那么问题来了，怎么表示这个格的位置了，B1 ? 还是B2 ? 或者是B3 ？

这时点一下这个格，发现

原来是B1，对应用VBA的cells(x,y)表示的话，就是cells(1,2)，表示第一行第二列的格子，注意A1是cells(1,1)，不是从(0,0)开始。

右往左移动:

cur = j + 3 - i
pre = i + 2 - i

cur当前移动的目标，pre表示当前移动目标的前一个，举个例子如上图的C移动到B，cur就是C，pre就是B。

先看for j 循环的移动，以最远目标为例(如D到C到B，最远就是D；E到D到C到B最远就是E)，如下表(由于对位问题，加-以示间隔)：

坐标----j=0-------1--------2

最远

C-------(3,1)

D ---------------(4,1)

E--------------------------(5,1)

那很明显规律就是cur 的X就是 j +3，cur的前一个pre就是 j +2，

然后再分析for i 循环，每次j包含的小移动，以j=2时:

i为0时，最远就是E，也就是(5,1)，移动到pre（也就是D），也就是(4,1);

接着i = 1，D移动到C，(4,1)到(3,1);

最后(3,1)到(2,1)。

由此可见每次小的移动cur = j + 3 - i，pre = j + 2 - i

最后，每行的行数为1,4,7,10，也就是y的值，因为每3行进行了合并单元格，而循环的k是从0递增到3，所以在循环中y的对应值的表达式为k*3 +1（用kLoop变量表示y）。

至于逻辑判断为调用函数：

Call gameRunLeftAndRight(kLoop, cur, pre)

以下为该函数的实现：

Public Function gameRunUpAndDown(kL%, cu%, pr%)If Cells(cu, kL).Value <> 0 ThenIf Cells(pr, kL).Value <> 0 ThenIf Cells(cu, kL).Value = Cells(pr, kL).Value Then 'equalCells(pr, kL).Value = Cells(pr, kL).Value * 2Cells(pr, kL).Interior.ColorIndex = arrColor(Log(Cells(pr, kL).Value) / Log(2))'resunme the before oneCells(cu, kL).Value = 0Cells(cu, kL).Interior.ColorIndex = arrColor(0)End IfElseCells(pr, kL).Value = Cells(cu, kL).Value 'the left is emptyCells(pr, kL).Interior.ColorIndex = Cells(cu, kL).Interior.ColorIndex'resunme the before oneCells(cu, kL).Value = 0Cells(cu, kL).Interior.ColorIndex = arrColor(0)End IfEnd If
End Function

其实也就对应一开始分析的情况，如C到B，结合上述代码先分析当前的cur，也就是C，为8，判断是否为0，不为零再判断前面的B是否为0，若B不为0再进行是否相等的判断，若B为0进行对应操作。其他情况不用处理。

这里再说一下这个的意思：

Log(Cells(pr, kL).Value) / Log(2)

Log函数为自然对数，也就是e为底，也就是lnX，要是求log2(8)，这样也可以求出：ln(8)/ln(2)，用上Log函数就是Log(8)/Log(2)。用一个数组保存颜色的索引值，因为当前格子非0的时候的数必然为2的N次方，所以用当前格子的值求2的对数，对应数组下标即可。

每次4行都向一个方向移动完，把剩下为0的格子随机变成2：

Public Function randomToNew()
Dim cellX%, cellY%, randomNumber%
For i = 0 To 15cellX = Int(i / 4) * 3 + 1cellY = i Mod 4 + 2If Cells(cellX, cellY).Value = 0 ThenIf Round(Rnd() * 15) > 13 ThenrandomNumber = Round(Rnd() * 1)Cells(cellX, cellY).Value = randomNumber * 2Cells(cellX, cellY).Interior.ColorIndex = arrColor(randomNumber)End IfEnd If
Next
End Function

每个格子的行，也就是X，取值为：1,4,7,10（因为每3行的格子进行了合并），数列为3n+1（注意循环从0开始，不是1）

每个格子的列，也就是Y，取值为：2,3,4,5，数列为n+2（循环从0开始，不是1）

用一个循环，0到15表示的话，如果进行如下这样标记的话(由于对位问题，加-以示间隔)：

(1,2)---(1,3)--(1,4)---(1,5)

(4,2)---(4,3)--(4,4)---(4,5)

(7,2)---(7,3)--(7,4)---(7,5)

(10,2) (10,3) (10,4) (10,5)

X的话，每4个i改变一次，所以n等于 i除以4，取整（直接i/4有小数，估计是i没有定义为整型，又或者是其他机制，没认真研究）。

Y的话，都是2,3,4,5重复出现4次，每个4个循环出现，所以n等于i跟4求余数，也就是 i Mod 4。

接着就是从0到15求一个随机数，为14或者15时，再从0和1中随机一次，为1时把为0的格子的值改为2，顺便改对应颜色的索引值。

2.excel设置准备：

引用别人的好了O(∩_∩)O~

http://www.cnblogs.com/ebs-blog/archive/2013/02/05/2892565.html

3.此版本的逻辑分析

对于合并并居中的操作，纯手动喔，没有用代码= =

全局变量以及颜色数组初始化对应的颜色索引值

Public arrColor As Variant
Public cur%, pre%, kLoop%
Public Function init()
arrColor = Array(40, 44, 45, 46, 38, 53, 54, 36, 34, 15, 20, 5, 25)
End Function

颜色索引值表：

http://wenku.baidu.com/link?url=BGTiHiszrM36ypaoFVIw5DOD6zWhi5TYaRhx2tLOUCA5WIAETVOKPUSrkWSXSjKDFkRytOWyPiw8Xun-0G9UjQHFBlD7p9gE2e85oYbJ7rS

重置模块，就是重新开始一局，对应的代码：

Sub bb()
Call init
Dim r1%
For i = 0 To 3For j = 0 To 3Cells((j * 3) + 1, i + 2).Value = 0Cells((j * 3) + 1, i + 2).Interior.ColorIndex = arrColor(0)Next
NextFor i = 0 To 3r1 = Round(Rnd() * 15)Cells((Int(r1 / 4) * 3 + 1), ((r1 Mod 4) + 2)).Value = 2Cells((Int(r1 / 4) * 3 + 1), ((r1 Mod 4) + 2)).Interior.ColorIndex = arrColor(1)
NextFor i = 0 To 1r1 = Round(Rnd() * 15)Cells((Int(r1 / 4) * 3 + 1), ((r1 Mod 4) + 2)).Value = 4Cells((Int(r1 / 4) * 3 + 1), ((r1 Mod 4) + 2)).Interior.ColorIndex = arrColor(2)
NextEnd Sub

先是调用颜色数组初始化，把全部的值改为0和数组下标为0时的颜色，接着随机生成最多4个格子数值为2的格子，然后再从这16个中再随机生成最多2个数值为4的格子。

上下移动判断的函数：

Public Function gameRunUpAndDown(kL%, cu%, pr%)If Cells(cu, kL).Value <> 0 ThenIf Cells(pr, kL).Value <> 0 ThenIf Cells(cu, kL).Value = Cells(pr, kL).Value Then 'equalCells(pr, kL).Value = Cells(pr, kL).Value * 2Cells(pr, kL).Interior.ColorIndex = arrColor(Log(Cells(pr, kL).Value) / Log(2))'resunme the before oneCells(cu, kL).Value = 0Cells(cu, kL).Interior.ColorIndex = arrColor(0)End IfElseCells(pr, kL).Value = Cells(cu, kL).Value 'the left is emptyCells(pr, kL).Interior.ColorIndex = Cells(cu, kL).Interior.ColorIndex'resunme the before oneCells(cu, kL).Value = 0Cells(cu, kL).Interior.ColorIndex = arrColor(0)End IfEnd If
End Function

左右移动判断的函数：

Public Function gameRunLeftAndRight(kL%, cu%, pr%)If Cells(kL, cu).Value <> 0 ThenIf Cells(kL, pr).Value <> 0 ThenIf Cells(kL, cu).Value = Cells(kL, pr).Value Then 'equalCells(kL, pr).Value = Cells(kL, pr).Value * 2Cells(kL, pr).Interior.ColorIndex = arrColor(Log(Cells(kL, pr).Value) / Log(2))'resunme the before oneCells(kL, cu).Value = 0Cells(kL, cu).Interior.ColorIndex = arrColor(0)End IfElseCells(kL, pr).Value = Cells(kL, cu).Value 'the left is emptyCells(kL, pr).Interior.ColorIndex = Cells(kL, cu).Interior.ColorIndex'resunme the before oneCells(kL, cu).Value = 0Cells(kL, cu).Interior.ColorIndex = arrColor(0)End IfEnd If
End Function

把数值为0的格子改为数值为2并改变对应颜色：

Public Function randomToNew()
Dim cellX%, cellY%, randomNumber%
For i = 0 To 15cellX = Int(i / 4) * 3 + 1cellY = i Mod 4 + 2If Cells(cellX, cellY).Value = 0 ThenIf Round(Rnd() * 15) > 13 ThenrandomNumber = Round(Rnd() * 1)Cells(cellX, cellY).Value = randomNumber * 2Cells(cellX, cellY).Interior.ColorIndex = arrColor(randomNumber)End IfEnd If
Next
End Function

上面讲过就不说了喔

向上移动模块：

Sub up()
Call init
For k = 0 To 3kLoop = k + 2For j = 0 To 2For i = 0 To jcur = 3 * (j - i) + 4pre = 3 * (j - i) + 1Call gameRunUpAndDown(kLoop, cur, pre)NextNext
Next
Call randomToNew
End Sub

向下移动模块

Sub down()
Call init
For k = 0 To 3kLoop = k + 2For j = 0 To 2For i = 0 To jcur = 7 - 3 * (j - i)pre = 10 - 3 * (j - i)Call gameRunUpAndDown(kLoop, cur, pre)NextNext
Next
Call randomToNew
End Sub

向左移动模块：

Sub left()
Call init
For k = 0 To 3kLoop = k * 3 + 1For j = 0 To 2For i = 0 To jcur = j + 3 - ipre = j + 2 - iCall gameRunLeftAndRight(kLoop, cur, pre)Debug.Print iNextNext
Next
Call randomToNew
End Sub

向右移动模块：

Sub right()
Call init
For k = 0 To 3kLoop = k * 3 + 1For j = 0 To 2For i = 0 To jcur = 4 - j + ipre = 5 - j + iCall gameRunLeftAndRight(kLoop, cur, pre)NextNext
Next
Call randomToNew
End Sub

最后，移动不了判定为输的逻辑没有做，到了2048就赢的逻辑没有做，分数没有做。。。。。。好多都没做= =...

4.试玩

先对照第2步进行设置，链接再放一次：

http://www.cnblogs.com/ebs-blog/archive/2013/02/05/2892565.html

其实本人只是把开发工具弄了出来，没有启用宏那些设置，只是保存带宏的excel时表格和vba文件要分开保存，略显麻烦。

源文件下载地址：http://download.csdn.net/detail/et_sandy/8211429

解压后打开2048改.xlsx，然后打开VB编辑器

接着导入VBA文件

要是想看代码就双击这里的模块1

如无意外就能玩了，如果按键的宏丢失，这样进行绑定就可以了：右键按钮，选指定宏

指定模块的名字

重置按钮对应bb

方向按钮名字对应模块名字的上下左右即可

喔，对了，没有研究能不能禁止表格的输入操作，于是，excel嘛，你可以直接修改表格的数值- -|||

Excel下2048的实现相关推荐

Java17 POI5.2.0 Excel 下拉框数据校验
Java 设置Excel 下拉框.自定义数据校验一.工具类 1.ExcelUtil 2.Pom 二.生成文件 1.下拉框 2.数据校验三.Excel 命令 1.获取活动单元格:=INDIRECT( ...
办公技巧：Excel下拉菜单小技巧，赶紧学一下！
今天小编给大家分享一个Excel下拉菜单的制作技巧,赶紧来学一下吧. 先来看常规的下拉菜单制作方法: 在制作下拉菜单时,序列来源只能是单行或单列的区域. 下面这个表格里,数据源是多行多列的,怎么办呢? ...
excel下拉隐藏_在Excel下拉列表中隐藏使用过的项目
excel下拉隐藏 You can add a drop down list in a cell, to make it easy for people to enter data. It's rea ...
excel下拉菜单vba_一站式提供不同的Excel下拉菜单
excel下拉菜单vba To help users enter data in a spreadsheet, you can create drop down lists with Excel's ...
在EXCEL下用VBA编程提高人事数据的管理效率
一.概述人力资源部承载着企业人员劳资.人事.培训.社保.档案及文件的大量数据信息,而且信息量随时间不断积累,不断地做阶段"积分"工作--汇总统计.存档,有时做"微分&q ...
计算机函数公式用法教程average,average函数怎么用？Excel下average函数的使用方法...
AVERAGE函数,意思是EXCEL表格中的计算平均值函数.关于sum函数的用法有很多,有不少朋友问到AVERAGE函数的用法.那么,在sum函数里的AVERAGE函数应该怎么运用呢?今天小编就教大家 ...
Excel下拉框设置多选
Excel下拉框一般只能单选,但有时候需要多选,多选的方法如下: 以office 2016中的excel为例: 1.数据验证入口 2.设置数据 3.sheet页右击查看代码 4.复制下面代码进去: 5 ...
Windows、Firefox、ideal、Excel下常用快捷键
Window下快捷键 Windows.Firefox.ideal.Excel下常用快捷键文章目录 Windows.Firefox.ideal.Excel下常用快捷键一.Windows系统快捷键 1 ...
excel下拉菜单vba_Excel 2007的经典菜单
excel下拉菜单vba I noticed that Bits du Jour was offering a 70% discount on "Excel 2007 Ribbon to o ...

Excel下2048的实现

Excel下2048的实现相关推荐

最新文章

热门文章