专业做网站公司怎么样,工作服规格,接私活做网站设计,哪个建设网站公司好做数独游戏的时候#xff0c;画在纸上很容易弄花眼#xff0c;所以我考虑用Excel辅助做一个。 界面如下#xff1a; 按下初始化表格区域按钮#xff0c;会在所有单元格中填充“123456789”。如下图#xff1a; 当某个单元格删除得只剩一个数字时#xff0c;会将同一行、…做数独游戏的时候画在纸上很容易弄花眼所以我考虑用Excel辅助做一个。 界面如下 按下初始化表格区域按钮会在所有单元格中填充“123456789”。如下图 当某个单元格删除得只剩一个数字时会将同一行、同一列和同一区域的其它单元格中的相同数字删除。如下图 实现上述效果的VBA如下 1、初始化按钮的代码
Sub startup_Click()Dim row%, col%For row 1 To 9For col 1 To 9Cells(row, col) 123456789NextNext
End Sub以上代码仅仅简单遍历相关单元格并填充字符串。 实现自动删除关联单元格中的数字的功能的代码放在工作表的Worksheet_Change事件中这样只要修改相关游戏区域中的单元格就会自动执行检查并删除有关数字。代码如下
Private Sub Worksheet_Change(ByVal Target As Range)Dim row%, col%, changeRow%, changeCol%, rngRow%, rngCol%, txt$changeRow Target.rowchangeCol Target.Column记录刚修改单元格的内容txt Cells(changeRow, changeCol)如果刚修改的单元格只剩下一个数字则执行自动消除If Len(txt) 1 Then防止修改单元格内容时工作表改变事件被循环触发Application.EnableEvents False确定同一区域单元格第一行行号If changeRow 4 ThenrngRow 1ElseIf changeRow 6 ThenrngRow 7ElserngRow 4End If确定同一区域单元格第一列列号If changeCol 4 ThenrngCol 1ElseIf changeCol 6 ThenrngCol 7ElserngCol 4End If将同一行、列及区域单元格中相关的数字删除For row 1 To 9For col 1 To 9If row changeRow Or col changeCol Or (row rngRow And row rngRow 3 _And col rngCol And col rngCol 3) ThenCells(row, col) Replace(Cells(row, col), txt, )End IfNextNextCells(changeRow, changeCol) txt恢复事件处理以继续响应工作表改变事件Application.EnableEvents TrueEnd If
End Sub下面再附上一个用VBA做数独的程序不过没有优化
Sub VBA做数独()Dim targetRegion As StringDim origStr, tmpStr, tStr As Stringi, j, r, c, tmpr, tmpc, tr, 用于遍历表格stackR为堆栈指针Dim i, j, r, c, tmpr, tmpc, tr, tc, tmpLen, targetRow, targetCol, stackR As IntegerDim change As BooleanDim startTime, endTime As DatestartTime Now()origStr 1,2,3,4,5,6,7,8,9targetRegion A1:I9stackR 1Application.ScreenUpdating False 填写:change FalseFor r 1 To 9For c 1 To 9If Len(Cells(r, c)) 1 ThentmpStr Cells(r, c) 单元格内容为已去掉用过的数字后的字串ElseIf Len(Cells(r, c)) 1 And Cells(r, c) 0 ThenGoTo 跳到下一单元格 单元格数字已确定跳到下一单元格ElsetmpStr origStr 单元格为空单元格设定内容为原始字符串End If 将同一行中已用过的数字从原始字串中去除For tmpc 1 To 9If Len(Cells(r, tmpc)) 1 ThenIf InStr(tmpStr, Cells(r, tmpc)) 0 ThentmpStr Replace(tmpStr, Cells(r, tmpc), )change TrueEnd IfEnd IfNext将同一列中已用过的数字从原始字串中去除For tmpr 1 To 9If Len(Cells(tmpr, c)) 1 ThenIf InStr(tmpStr, Cells(tmpr, c)) 0 ThentmpStr Replace(tmpStr, Cells(tmpr, c), )change TrueEnd IfEnd IfNext将同一区域中已用过的数字从原始字串中去除If r 4 Thentr 1ElseIf r 6 Thentr 7Elsetr 4End If If c 4 Thentc 1ElseIf c 6 Thentc 7Elsetc 4End IfFor tmpr tr To tr 2For tmpc tc To tc 2If Len(Cells(tmpr, tmpc)) 1 ThenIf InStr(tmpStr, Cells(tmpr, tmpc)) 0 ThentmpStr Replace(tmpStr, Cells(tmpr, tmpc), )change TrueEnd IfEnd IfNextNexttStr Replace(tmpStr, ,, )某个单元格的数字全部删完那么这种填法错误If Len(tStr) 0 ThenIf stackR 10 Then出栈Range(A stackR :i stackR 8).SelectSelection.CutRange(A1).SelectPaste调整堆栈指针stackR stackR - 10GoTo 填写ElseMsgBox (﹏)~这题无解。 堆栈到底没有可能情况了无解Exit SubEnd If ElseIf Len(tStr) 1 ThenCells(r, c) tStrElseCells(r, c) tmpStrEnd IftmpStr origStrtStr 跳到下一单元格:NextNext If change False ThenFor r 1 To 9For c 1 To 9 分析同一行的情况判断是否出现可确定数字的单元格For tmpc 1 To 9If Len(Cells(r, tmpc)) 1 ThentStr tStr Cells(r, tmpc)End IfNext For i 1 To 9If Len(tStr) - Len(Replace(tStr, i, )) 1 ThenFor tmpc 1 To 9If InStr(Cells(r, tmpc), i) 0 ThenCells(r, tmpc) iGoTo 填写End IfNextEnd IfNexttStr 分析同一列的情况判断是否出现可确定数字的单元格For tmpr 1 To 9If Len(Cells(tmpr, c)) 1 ThentStr tStr Cells(tmpr, c)End IfNextFor i 1 To 9If Len(tStr) - Len(Replace(tStr, i, )) 1 ThenFor tmpr 1 To 9If InStr(Cells(tmpr, c), i) 0 ThenCells(tmpr, c) iGoTo 填写End IfNextEnd IfNexttStr 分析同一区域的情况判断是否出现可确定数字的单元格If r 4 Thentr 1ElseIf r 6 Thentr 7Elsetr 4End IfIf c 4 Thentc 1ElseIf c 6 Thentc 7Elsetc 4End IfFor tmpr tr To tr 2For tmpc tc To tc 2If Len(Cells(tmpr, tmpc)) 1 ThentStr tStr Cells(tmpr, tmpc)End IfNextNextFor i 1 To 9If Len(tStr) - Len(Replace(tStr, i, )) 1 ThenFor tmpr tr To tr 2For tmpc tc To tc 2If InStr(Cells(tmpr, tmpc), i) 0 ThenCells(tmpr, tmpc) iGoTo 填写End IfNextNextEnd IfNext NextNextFor r 1 To 9For c 1 To 9If Len(Cells(r, c)) 1 Then找到可填数字最少的未定单元格也就是其中字符串长度最短的使堆栈最小tmpLen 17For i 1 To 9For j 1 To 9If Len(Cells(i, j)) 1 And Len(Cells(i, j)) tmpLen ThentmpLen Len(Cells(i, j))targetRow itargetCol jEnd IfNextNextRange(targetRegion).Copyp 1s Replace(Cells(targetRow, targetCol), ,, )将所有可能情况入栈最后一种可能情况直接在目标区修改While p Len(s)stackR stackR 10Range(A stackR).SelectPasteCells(stackR targetRow - 1, targetCol) Mid(s, p, 1)p p 1WendCells(targetRow, targetCol) Mid(s, p, 1)GoTo 填写End IfNextNext ElseGoTo 填写End IfApplication.ScreenUpdating TrueendTime Now()MsgBox ~\(≧▽≦)/~解决了!耗时 Application.Text(endTime - startTime, m:s)End Sub
