用Excel辅助做数独

做数独游戏的时候，画在纸上很容易弄花眼，所以我考虑用Excel辅助做一个。
界面如下：
在这里插入图片描述
按下初始化表格区域按钮，会在所有单元格中填充“123456789”。如下图：
在这里插入图片描述
当某个单元格删除得只剩一个数字时，会将同一行、同一列和同一区域的其它单元格中的相同数字删除。如下图：
在这里插入图片描述
实现上述效果的VBA如下：
1、初始化按钮的代码：

Sub startup_Click()Dim row%, col%For row = 1 To 9For col = 1 To 9Cells(row, col) = "'123456789"NextNext
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 String'i, 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,9"targetRegion = "A1:I9"stackR = 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

本文来自互联网用户投稿，该文观点仅代表作者本人，不代表本站立场。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如若转载，请注明出处：http://www.hqwc.cn/news/433432.html

如若内容造成侵权/违法违规/事实不符，请联系编程知识网进行投诉反馈email:809451989@qq.com，一经查实，立即删除！

相关文章

【分布式技术专题】「分布式技术架构」 探索Tomcat技术架构设计模式的奥秘（Server和Service组件原理分析）

【分布式技术专题】「分布式技术架构」 探索Tomcat技术架构设计模式的奥秘（Server和Service组件原理分析）

探索Tomcat技术架构设计模式的奥秘 Tomcat系统架构分析Tomcat 整体结构Tomcat总体结构图以 Service 作为“婚姻”1) Service 接口方法列表 2) StandardService 的类结构图方法列表 3) StandardService. SetContainer4) StandardService. addConnector 以 Server 为“居”1) Ser…
阅读更多...
[ACM学习] 树形dp之换根

[ACM学习] 树形dp之换根

算法概述 总的来说&#xff1a; 题目描述&#xff1a;一棵树求哪一个节点为根时&#xff0c;XXX最大或最小 分为两步&#xff1a;1. 树形dp 2. 第二次dfs 问题引入 如果暴力就是 O(n^2) &#xff0c; 当从1到2的时候&#xff0c;2及其子树所有的深度都减一&#xff0c;其它…
阅读更多...
【AndroidStudio】2022.3Giraffe连接超时，更换下载源，使用本地gradle，版本对应问题

【AndroidStudio】2022.3Giraffe连接超时，更换下载源，使用本地gradle，版本对应问题

记录了使用AndroidStudio2022.3 Giraffe版本在搭建环境时遇到的问题&#xff0c;包括连接超时&#xff0c;gradle无法读取等。 如果只看如何正确的配置&#xff0c;直接跳转第3节 配置汇总 1 连接超时 项目一开始会自动下载gardle文件来加载项目 1.1 Connect timed out 基…
阅读更多...
Vulnhub靶场DC-3

Vulnhub靶场DC-3

本机192.168.223.128 靶机192.168.223.139 目标发现nmap -sP 192.168.223.0/24 端口扫描nmap -p- 192.168.223.139 之开启了一个80端口 看一下是什么服务 nmap -sV -p- -A 192.168.223.139是一个apache服务&#xff0c;joomla模板 看一下web 没什么有用信息。 扫描一下后台…
阅读更多...
高学历人士互相残害现象的深度剖析与教育体制反思

高学历人士互相残害现象的深度剖析与教育体制反思

高学历人士互相残害现象的深度剖析与教育体制反思 In-Depth Analysis and Educational System Reflection on the Phenomenon of High-Educated Individuals Harming Each Other 在当今社会&#xff0c;随着教育水平的普遍提升&#xff0c;高学历人士之间的恶性事件时有发生&am…
阅读更多...
【代码随想录15】110.平衡二叉树 257. 二叉树的所有路径 404.左叶子之和

【代码随想录15】110.平衡二叉树 257. 二叉树的所有路径 404.左叶子之和

目录 110. 平衡二叉树题目描述参考代码 257. 二叉树的所有路径题目描述参考代码 404.左叶子之和题目描述参考代码 110. 平衡二叉树 题目描述 给定一个二叉树&#xff0c;判断它是否是高度平衡的二叉树。 本题中&#xff0c;一棵高度平衡二叉树定义为&#xff1a; 一个二叉树…
阅读更多...
MIT_线性代数笔记：线性代数常用计算公式

MIT_线性代数笔记：线性代数常用计算公式

目录 1.矩阵的加法和数乘2.矩阵的乘法3.转置 Transposes 相关运算 1.矩阵的加法和数乘 2.矩阵的乘法 1)标准方法&#xff08;行乘以列&#xff09; 矩阵乘法的标准计算方法是通过矩阵 A 第 i 行的行向量和矩阵 B 第 j 列的列向量点积得到 cij。即我们常说的点积&#xff0c;也…
阅读更多...
【操作系统】调用硬盘并且实现MBR与Loader的过渡——原理篇

【操作系统】调用硬盘并且实现MBR与Loader的过渡——原理篇

一.概述 前文&#xff08;【操作系统】优化MBR程序&#xff1a;让MBR调用显存吧&#xff09;中的MBR程序仅有512字节大小&#xff0c;完全不能将内核成功加载到内存并且运行&#xff0c;所以我们需要在另一个程序中完成初始化环境以及加载内核的任务&#xff0c;这个程序称之为…
阅读更多...
pip 安装出现报错 SSLError(SSLError(“bad handshake

pip 安装出现报错 SSLError(SSLError(“bad handshake

即使设置了清华源&#xff1a; pip config set global.index-url https://pypi.tuna.tsinghua.edu.cn/simplepip 安装包不能配置清华源&#xff0c;出现报错: Retrying (Retry(total2, connectNone, readNone, redirectNone, statusNone)) after connection broken by ‘SSLE…
阅读更多...
.NET中的matplotlib平替，ScottPlot简单使用

.NET中的matplotlib平替，ScottPlot简单使用

文章目录 前言解决方案Python调用.NET 原生解决 ScottPlot找到文章ScottPlot Nuget安装简单代码测试代码跑不了5.0新版本测试 总结 前言 我之前在学OpenCV 三语言开发的时候&#xff0c;遇到了一个问题&#xff0c;怎么可视化的显示数据。Python有matplotlib&#xff0c;那么C…
阅读更多...
node.js漏洞总结

node.js漏洞总结

js开发的web应用和php/Java最大的区别就是js可以通过查看源代码的方式查看到编写的代码&#xff0c;但是php/Java的不能看到&#xff0c;也就是说js开发的web网页相当于可以进行白盒测试。 流行的js框架有&#xff1a; 1. AngularJS 2. React JS 3. Vue 4. jQuery 5. Backbone…
阅读更多...
Python学习从0到1 day9 Python函数

Python学习从0到1 day9 Python函数

苦难是花开的伏笔 ——24.1.25 函数 1.定义 函数&#xff1a;是组织好的&#xff0c;可重复使用的&#xff0c;用来实现特定功能的代码段 2.案例 在pycharm中完成一个案例需求&#xff1a;不使用内置函数len&#xff08;&#xff09;&#xff0c;完成字符串长度的计算 #统计字…
阅读更多...
推荐文章
最新文章

Copyright @ 2022~2023