Excel下2048的实现

来源：互联网发布：音频剪辑软件哪个好编辑：程序博客网时间：2024/06/04 17:52

环境：

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 3    kLoop = k * 3 + 1    For j = 0 To 2        For i = 0 To j            cur = j + 3 - i            pre = j + 2 - i            Call gameRunLeftAndRight(kLoop, cur, pre)        Next    NextNext

这里用了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 - ipre = 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 Then                If Cells(pr, kL).Value <> 0 Then                    If Cells(cu, kL).Value = Cells(pr, kL).Value Then 'equal                        Cells(pr, kL).Value = Cells(pr, kL).Value * 2                        Cells(pr, kL).Interior.ColorIndex = arrColor(Log(Cells(pr, kL).Value) / Log(2))                        'resunme the before one                        Cells(cu, kL).Value = 0                        Cells(cu, kL).Interior.ColorIndex = arrColor(0)                    End If                Else                    Cells(pr, kL).Value = Cells(cu, kL).Value 'the left is empty                    Cells(pr, kL).Interior.ColorIndex = Cells(cu, kL).Interior.ColorIndex                     'resunme the before one                    Cells(cu, kL).Value = 0                    Cells(cu, kL).Interior.ColorIndex = arrColor(0)                End If            End IfEnd 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 15    cellX = Int(i / 4) * 3 + 1    cellY = i Mod 4 + 2    If Cells(cellX, cellY).Value = 0 Then        If Round(Rnd() * 15) > 13 Then            randomNumber = Round(Rnd() * 1)            Cells(cellX, cellY).Value = randomNumber * 2            Cells(cellX, cellY).Interior.ColorIndex = arrColor(randomNumber)        End If    End IfNextEnd 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 VariantPublic 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 initDim r1%For i = 0 To 3    For j = 0 To 3        Cells((j * 3) + 1, i + 2).Value = 0        Cells((j * 3) + 1, i + 2).Interior.ColorIndex = arrColor(0)    NextNextFor i = 0 To 3    r1 = Round(Rnd() * 15)    Cells((Int(r1 / 4) * 3 + 1), ((r1 Mod 4) + 2)).Value = 2    Cells((Int(r1 / 4) * 3 + 1), ((r1 Mod 4) + 2)).Interior.ColorIndex = arrColor(1)NextFor i = 0 To 1    r1 = Round(Rnd() * 15)    Cells((Int(r1 / 4) * 3 + 1), ((r1 Mod 4) + 2)).Value = 4    Cells((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 Then                If Cells(pr, kL).Value <> 0 Then                    If Cells(cu, kL).Value = Cells(pr, kL).Value Then 'equal                        Cells(pr, kL).Value = Cells(pr, kL).Value * 2                        Cells(pr, kL).Interior.ColorIndex = arrColor(Log(Cells(pr, kL).Value) / Log(2))                        'resunme the before one                        Cells(cu, kL).Value = 0                        Cells(cu, kL).Interior.ColorIndex = arrColor(0)                    End If                Else                    Cells(pr, kL).Value = Cells(cu, kL).Value 'the left is empty                    Cells(pr, kL).Interior.ColorIndex = Cells(cu, kL).Interior.ColorIndex                     'resunme the before one                    Cells(cu, kL).Value = 0                    Cells(cu, kL).Interior.ColorIndex = arrColor(0)                End If            End IfEnd Function

左右移动判断的函数：

Public Function gameRunLeftAndRight(kL%, cu%, pr%) If Cells(kL, cu).Value <> 0 Then                If Cells(kL, pr).Value <> 0 Then                    If Cells(kL, cu).Value = Cells(kL, pr).Value Then 'equal                        Cells(kL, pr).Value = Cells(kL, pr).Value * 2                        Cells(kL, pr).Interior.ColorIndex = arrColor(Log(Cells(kL, pr).Value) / Log(2))                        'resunme the before one                        Cells(kL, cu).Value = 0                        Cells(kL, cu).Interior.ColorIndex = arrColor(0)                    End If                Else                    Cells(kL, pr).Value = Cells(kL, cu).Value 'the left is empty                    Cells(kL, pr).Interior.ColorIndex = Cells(kL, cu).Interior.ColorIndex                     'resunme the before one                    Cells(kL, cu).Value = 0                    Cells(kL, cu).Interior.ColorIndex = arrColor(0)                End If            End IfEnd Function

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

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

上面讲过就不说了喔

向上移动模块：

Sub up()Call initFor k = 0 To 3    kLoop = k + 2    For j = 0 To 2        For i = 0 To j            cur = 3 * (j - i) + 4            pre = 3 * (j - i) + 1            Call gameRunUpAndDown(kLoop, cur, pre)        Next    NextNextCall randomToNewEnd Sub

向下移动模块

Sub down()Call initFor k = 0 To 3    kLoop = k + 2    For j = 0 To 2        For i = 0 To j            cur = 7 - 3 * (j - i)            pre = 10 - 3 * (j - i)            Call gameRunUpAndDown(kLoop, cur, pre)        Next    NextNextCall randomToNewEnd Sub

向左移动模块：

Sub left()Call initFor k = 0 To 3    kLoop = k * 3 + 1    For j = 0 To 2        For i = 0 To j            cur = j + 3 - i            pre = j + 2 - i            Call gameRunLeftAndRight(kLoop, cur, pre)            Debug.Print i        Next    NextNextCall randomToNewEnd Sub

向右移动模块：

Sub right()Call initFor k = 0 To 3    kLoop = k * 3 + 1    For j = 0 To 2        For i = 0 To j            cur = 4 - j + i            pre = 5 - j + i            Call gameRunLeftAndRight(kLoop, cur, pre)        Next    NextNextCall randomToNewEnd 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编辑器