Excel中通过VBA进行迷宫游戏

整体来说,算法优劣什么的没考虑过。当时就是想如果我用笔在纸上面画一个迷宫应该怎么画,然后代码就写出来了。可能整体的效率很低。

代码实现两个功能:

1、迷宫绘制:

Main函数就是干这个的。

2、迷宫游戏:

Reset函数用来进行一些初始设定(每次玩之前都要设定一下);

其他的就是利用Excel的Worksheet_SelectionChange函数实现“走步”。

有兴趣的朋友可以拿来玩一玩,消磨时间。

具体的使用:

将整个代码拷贝到Sheet1的编辑框(因为Worksheet_SelectionChange函数的限制)。

然后再Sheet1中建立两个按钮:

第一个按钮名字改成“生成”,指向的宏设置为“Main”;

第二个按钮名字叫“开始”,制定的宏设置为“Reset”。

如果顺序错了可能不好用。VBA我也不是很明白,就是没事琢磨了一下,没有系统的学过。

然后,在“H2”的位置输入迷宫的大小,是一个5~250之间的数字。当然也可以适当的修饰一下。比如附图的形式:

附:代码

‘1–Up’0–Down’3–Left’2–Right’x–Row;y–Column’本程序算法无所谓快慢,完全按着普通人思维方式完成DimiMazeSizeAsIntegerDimiMaze(251,251)AsVariantDimx,y,iGetRndRet,iPOrder,iNoWayAsIntegerDimsubx,subyAsIntegerDimiStartLineAsIntegerDimbInitAsBooleanDimbGoStartAsBooleanDimbDrawingAsBooleanDimCrtRow,CrtClmAsIntegerDimBckRow,BckClmAsIntegerDimiRowMax,iColumnMaxAsIntegerDimiStepCntAsIntegerSubReset()bGoStart=NotbGoStartIf(bGoStart)ThenActiveSheet.Shapes("Button2").SelectSelection.Characters.Text="结束"iStepCnt=0ActiveSheet.Cells(3,8)=iStepCntBckRow=6BckClm=2OutMazeColor6,2,51Cells(6,2).SelectFori=7ToActiveSheet.UsedRange.Rows.CountForj=5ToActiveSheet.UsedRange.Columns.CountIf(Cells(i,j).Interior.ColorIndex=15)TheniRowMax=iiColumnMax=jEndIfNextNextElseActiveSheet.Shapes("Button2").SelectSelection.Characters.Text="开始"EndIfEndSubPrivateSubWorksheet_SelectionChange(ByValTargetAsRange)If((bGoStart)And(NotbDrawing))ThenCrtRow=ActiveCell.RowCrtClm=ActiveCell.ColumnIfNot(bInit)ThenBckRow=6BckClm=2bInit=TrueEndIfOutMazeColorBckRow,BckClm,2If((Abs(CrtRow-BckRow)<=1)And(Abs(CrtClm-BckClm)<=1))ThenIf(CrtRow=(iRowMax))And(CrtClm=(iColumnMax))ThenMsgBox"Succ!"bGoStart=FalseActiveSheet.Shapes("Button2").SelectSelection.Characters.Text="开始"OutMazeColorCrtRow,CrtClm,51ActiveSheet.Cells(CrtRow,CrtClm).SelectElseIf(Cells(CrtRow,CrtClm).Interior.ColorIndex<>2)ThenCrtRow=BckRowCrtClm=BckClmOutMazeColorCrtRow,CrtClm,51ActiveSheet.Cells(BckRow,BckClm).SelectElseiStepCnt=iStepCnt+1ActiveSheet.Cells(3,8)=iStepCntOutMazeColorCrtRow,CrtClm,51ActiveSheet.Cells(CrtRow,CrtClm).SelectEndIfElseCrtRow=BckRowCrtClm=BckClmOutMazeColorCrtRow,CrtClm,51ActiveSheet.Cells(BckRow,BckClm).SelectEndIfBckRow=CrtRowBckClm=CrtClmEndIfEndSubSubmaim()iMazeSize=Cells(2,8)iStartLine=5If((5<=iMazeSize)And(iMazeSize<=250))ThenElseIf(iMazeSize=0)TheniMazeSize=20ElseMsgBox"迷宫大小应该在5~250之间。"ExitSubEndIfFori=0To251Forj=0To251iMaze(i,j)=0NextNextMakeMazeOutMazeEndSubPrivateSubMakeMaze()MakeMazeMainLineMakeMazeSubLineEndSubPrivateSubOutMaze()DimiAsLongiRowMax=ActiveSheet.UsedRange.Rows.CountiColumnMax=ActiveSheet.UsedRange.Columns.CountRange(Cells(1,1),Cells(iRowMax,iColumnMax)).SelectSelection.Interior.ColorIndex=xlNoneFori=1ToiMazeSize+2Columns(i).SelectSelection.ColumnWidth=1.75NextForj=1ToiMazeSize+2OutMazeColoriStartLine,j,50NextFori=iStartLineToiMazeSize+iStartLine-1OutMazeColori+1,1,50Forj=1ToiMazeSizeIf(iMaze(i-iStartLine,j-1)=1)ThenOutMazeColori+1,j+1,2ElseIf(iMaze(i-iStartLine,j-1)=2)ThenOutMazeColori+1,j+1,2ElseIf(iMaze(i-iStartLine,j-1)=0)ThenOutMazeColori+1,j+1,16ElseIf(iMaze(i-iStartLine,j-1)=99)ThenOutMazeColori+1,j+1,15ElseIf(iMaze(i-iStartLine,j-1)=100)ThenOutMazeColori+1,j+1,15ElseOutMazeColori+1,j+1,16EndIfNextOutMazeColori+1,j+1,50NextForj=1ToiMazeSize+2OutMazeColoriStartLine+iMazeSize+1,j,50NextCells(1,1).SelectEndSubPrivateSubOutMazeColor(ByValxAsInteger,ByValyAsInteger,ByValcAsInteger)bDrawing=TrueRange(Cells(x,y),Cells(x,y)).SelectWithSelection.Interior.ColorIndex=c.Pattern=xlSolidEndWithbDrawing=FalseEndSubPrivateSubMakeMazeMainLine()x=0y=0iPOrder=3iMaze(x,y)=1iMaze(iMazeSize,iMazeSize)=1DoWhile(y<iMazeSize-2)iGetRndRet=iGetRndMod6If(iGetRndRet=0OriGetRndRet=4)ThenIf((y>=(iMazeSize-2))Or(iPOrder=3))ThenElsey=y+1iMaze(y,x)=1y=y+1iMaze(y,x)=1iPOrder=0EndIfElseIf(iGetRndRet=1OriGetRndRet=3)ThenIf((x>=(iMazeSize-2))Or(iPOrder=2))ThenElsex=x+1iMaze(y,x)=1x=x+1iMaze(y,x)=1iPOrder=1EndIfElseIf(iGetRndRet=2OriGetRndRet=5)ThenIf((x<=3)Or(iPOrder=1)Or(iPOrder=3))ThenElsex=x-1iMaze(y,x)=1x=x-1iMaze(y,x)=1iPOrder=2EndIfEndIfLoopFori=xToiMazeSizeiMaze(y,i)=1NextEndSubPrivateSubMakeMazeSubLine()DimiFlagAsBooleanDimiCntAsIntegeriFlag=TrueDoWhile((iFlag)And(iCnt<100))iCnt=iCnt+1iPOrder=4iNoWay=0iFlag=FalseForsubx=0ToiMazeSizeStep1Forsuby=0ToiMazeSizeStep1If(GetNeedWay(suby,subx))ThenIfGetLeftWay(suby,subx)ThenDrawSubLineiMaze(y,x)=2EndIfIfGetRightWay(suby,subx)ThenDrawSubLineiMaze(y,x)=2EndIfIfGetUpWay(suby,subx)ThenDrawSubLineiMaze(y,x)=2EndIfIfGetDownWay(suby,subx)ThenDrawSubLineiMaze(y,x)=2EndIfiFlag=TrueEndIfNextNextLoopiMaze(0,0)=99iMaze(iMazeSize-1,iMazeSize-1)=100EndSubPrivateFunctionGetLeftWay(ByValiyAsInteger,ByValixAsInteger)AsBooleanForj=iyTo1Step-1If((((j/2)=(Int(j/2))))And((ix/2)=(Int(ix/2))))ThenIf(iMaze(j,ix)<>0)Thenx=ixy=jGetLeftWay=TrueExitFunctionEndIfEndIfNextGetLeftWay=FalseEndFunctionPrivateFunctionGetRightWay(ByValiyAsInteger,ByValixAsInteger)AsBooleanForj=iyToiMazeSizeStep1If((((j/2)=(Int(j/2))))And((ix/2)=(Int(ix/2))))ThenIf(iMaze(j,ix)<>0)Thenx=ixy=jGetRightWay=TrueExitFunctionEndIfEndIfNextGetRightWay=FalseEndFunctionPrivateFunctionGetUpWay(ByValiyAsInteger,ByValixAsInteger)AsBooleanForj=ixTo1Step-1If((((j/2)=(Int(j/2))))And((iy/2)=(Int(iy/2))))ThenIf(iMaze(iy,j)<>0)Thenx=jy=iyGetUpWay=TrueExitFunctionEndIfEndIfNextGetUpWay=FalseEndFunctionPrivateFunctionGetDownWay(ByValiyAsInteger,ByValixAsInteger)AsBooleanForj=ixToiMazeSizeStep1If((((j/2)=(Int(j/2))))And((iy/2)=(Int(iy/2))))ThenIf(iMaze(iy,j)<>0)Thenx=jy=iyGetDownWay=TrueExitFunctionEndIfEndIfNextGetDownWay=FalseEndFunctionPrivateFunctionGetNeedWay(ByValiyAsInteger,ByValixAsInteger)AsBooleanDimiSumAsIntegeriSum=0Fori=0To1Forj=0To1iSum=iSum+iMaze(iy+i,ix+j)NextNextIf(iy>=(iMazeSize-1))ThenGetNeedWay=FalseElseIf(ix>=(iMazeSize-1))ThenGetNeedWay=FalseElseIf(ix<2)ThenGetNeedWay=FalseElseIf(iy<2)ThenGetNeedWay=FalseElseIf(iSum=0)ThenGetNeedWay=TrueElseGetNeedWay=FalseEndIfEndFunctionPrivateSubDrawSubLine()iNoWay=0DoWhile(1)iGetRndRet=iGetRndMod4If(iGetRndRet=0)ThenIf(y>(iMazeSize-2))TheniNoWay=iNoWay+1ElseIf((iMaze(y+2,x)<>0))TheniNoWay=iNoWay+1ElseIf(iPOrder=1)ThenElsey=y+1iMaze(y,x)=2y=y+1iMaze(y,x)=2iPOrder=0EndIfElseIf(iGetRndRet=1)ThenIf((y<2))TheniNoWay=iNoWay+1ElseIf((iMaze(y-2,x)<>0))TheniNoWay=iNoWay+1ElseIf(iPOrder=0)ThenElsey=y-1iMaze(y,x)=2y=y-1iMaze(y,x)=2iPOrder=1EndIfElseIf(iGetRndRet=2)ThenIf((x>(iMazeSize-2)))TheniNoWay=iNoWay+1ElseIf(iMaze(y,x+2)<>0)TheniNoWay=iNoWay+1ElseIf(iPOrder=3)ThenElsex=x+1iMaze(y,x)=2x=x+1iMaze(y,x)=2iPOrder=3EndIfElseIf(iGetRndRet=3)ThenIf((x<2))TheniNoWay=iNoWay+1ElseIf(iMaze(y,x-2)<>0)TheniNoWay=iNoWay+1ElseIf((iPOrder=1)Or(iPOrder=2))ThenElsex=x-1iMaze(y,x)=2x=x-1iMaze(y,x)=2iPOrder=3EndIfEndIfIf(iNoWay>=4)ThenExitDoEndIfLoopEndSubPrivateFunctioniGetRnd()AsIntegeriGetRnd=Int((1000-0+1)*Rnd+0)EndFunction上帝从不埋怨人们的愚昧,人们却埋怨上帝的不公

Excel中通过VBA进行迷宫游戏

相关文章:

你感兴趣的文章:

标签云: