ExcelTip.Net留存知识帖 ---【注：附件之前被网盘供应商清空后，现已修复-现已修复-现已修复为本地下载！】
现在位置：首页 > 我的酷贴 > Excel VBA > 关于查找和判断单元格相连并且相加和等于25的解题思路分享

关于查找和判断单元格相连并且相加和等于25的解题思路分享

作者：绿色风 分类： 时间：2022-08-18 浏览：196
楼主
kevinchengcw		 关于查找和判断单元格相连并且相加和等于25的解题思路分享

相信大家基本上都玩过扫雷游戏，游戏涉及到一个交集的问题，本问题的解题思路就借鉴了该方法，所不同的是我们是以中心单元格的交集数来判断，而不是四周。

 

我们以一个单元格为中心，其周围会有八个单元格的区域可能出现其他的单元格，如下图

   红色是中心单元格，**Э赡艹鱿制渌行牡ピ竦姆段?/font
首先考虑，当五个单元格相连时，最少会有几个交集区，下图是交集最少的情况例子

  或
 或
 

也就是当两头的单元格与其他单元格只有一个交集，中间单元格与其他单元格只有两个交集时，于是我们得到了最少的单元格交集数，1+2+2+2+1=8，但是还不全对，并不是达到这个值就一定是全部紧邻的，还有下面的情况也满足数量，但并不是全部相连的

  或
 

所以，除了要判断交集数量外，还要判断是否有孤立的一个或两个单元格，判断有一个孤立的单元格只需要判断五个单元格中是否有一个单元格与其他任何单元格都没有交集即可，判断两个单元格是否孤立在外则要判断是否存在两个相邻并且与其他单元格只有一个交集的情况。

思路有了，下面是看一下所面对的情况，题目中的情况如下图：

  寻找单元格内相邻的五个数字单元格，且数值不同，相加之和等于25。
第一步：将单元格范围赋值给一个Range变量，从而可以用下标提取出相应的单元格。
第二步：因为是要找出相邻的五个单元格，所以我们设置五个变量，让第一个变量值范围从1到单元计数减4，即从第一个到倒数第五个，第二个变量从第一个变量加1到单元格计数减3，即永远是第一个变量的下一个，从而保证不重复，依此类推，设定好五个变量的范围及循环嵌套关系。
第三步：循环时每个变量做为下标，先判断对应单元格是否为空值，非空时是否与外层嵌套中的变量对应的单元格值相等，全部变量满足作为下标时对应的单元格不为空且各个单元格的值全不相等，则进入下面的核心判断过程。
第四步：首先判断五个单元格的交集区域个数，用单元格坐标加offset来判断在八个offset的单元地址是否与其他单元格相同，从而判断交集数。
情况1：当有任意一个单元格的交集数为0时则跳出循环，因为这表明这是一个孤立的单元格，未与其他单元格相邻，不合题意，跳过。
情况2：当一个单元格与其他单元格的交集数为1时，继续判断与他相交的单元格与其他单元格的交集数，如果也为1，则证明是两个孤立的单元格，不符合题意，跳过。
情况3：五个判断完后相加的总和大于8且未出现上述两种情况的组合，符合题意，予以标示记录。
第五步：程序加工润色，提升视觉效果。

综上，一个提速的方法是先建立一个非空值的单元格地址数组，则可省略五个变量循环判断一次的时间。
详见附件


  2. Sub test()
  3. Dim Rng, Uni As Range
  4. Dim A, B, C, D, E, F, G, H, I, J, K, L, M, N, P, Q As Integer
  5. Dim Ad As String
  6. Dim Arr
  7. tt = MsgBox("您是否要检测搜索到的结果?", vbYesNo)
  8. If tt = vbNo Then Application.ScreenUpdating = False
  9. Set Rng = Range("g5:k12")
  10. M = Rng.Cells.Count
  11. N = 0
  12. For A = 1 To M - 4
  13.     If Rng(A) <> "" Then
  14.     For B = A + 1 To M - 3
  15.         If Rng(B) <> "" And Rng(B) <> Rng(A) Then
  16.         For C = B + 1 To M - 2
  17.             If Rng(C) <> "" And Rng(C) <> Rng(B) And Rng(C) <> Rng(A) Then
  18.             For D = C + 1 To M - 1
  19.                 If Rng(D) <> "" And Rng(D) <> Rng(A) And Rng(D) <> Rng(B) And Rng(D) <> Rng(C) Then
  20.                 For E = D + 1 To M
  21.                     If Rng(E) <> "" And Rng(E) <> Rng(A) And Rng(E) <> Rng(B) And Rng(E) <> Rng(C) And Rng(E) <> Rng(D) Then
  22.                         If Rng(A).Value + Rng(B).Value + Rng(C).Value + Rng(D).Value + Rng(E).Value = 25 Then
  23.                             Arr = Array(Rng(A).Address, Rng(B).Address, Rng(C).Address, Rng(D).Address, Rng(E).Address)
  24.                             'Debug.Print Rng(A).Address & " : " & Rng(B).Address & " : " & Rng(C).Address & " : " & Rng(D).Address & " : " & Rng(E).Address
  25.                             K = 0
  26.                             For G = 0 To 4
  27.                                 J = 0
  28.                                 For H = 0 To 4
  29.                                     If H <> G Then
  30.                                         Select Case Arr(H)
  31.                                             Case Is = Range(Arr(G)).Offset(-1, -1).Address
  32.                                                 Ad = Arr(H)
  33.                                                 J = J + 1
  34.                                             Case Is = Range(Arr(G)).Offset(-1, 0).Address
  35.                                                 Ad = Arr(H)
  36.                                                 J = J + 1
  37.                                             Case Is = Range(Arr(G)).Offset(-1, 1).Address
  38.                                                 Ad = Arr(H)
  39.                                                 J = J + 1
  40.                                             Case Is = Range(Arr(G)).Offset(0, -1).Address
  41.                                                 Ad = Arr(H)
  42.                                                 J = J + 1
  43.                                             Case Is = Range(Arr(G)).Offset(0, -1).Address
  44.                                                 Ad = Arr(H)
  45.                                                 J = J + 1
  46.                                             Case Is = Range(Arr(G)).Offset(1, -1).Address
  47.                                                 Ad = Arr(H)
  48.                                                 J = J + 1
  49.                                             Case Is = Range(Arr(G)).Offset(1, 0).Address
  50.                                                 Ad = Arr(H)
  51.                                                 J = J + 1
  52.                                             Case Is = Range(Arr(G)).Offset(1, 1).Address
  53.                                                 Ad = Arr(H)
  54.                                                 J = J + 1
  55.                                         End Select
  56.                                     End If
  57.                                 Next H
  58.                                 If J = 0 Then GoTo skip1
  59.                                 If J = 1 Then
  60.                                     Q = 0
  61.                                     For L = 0 To 4
  62.                                         P = 0
  63.                                         If Arr(L) <> Ad Then
  64.                                             Select Case Arr(L)
  65.                                                 Case Is = Range(Ad).Offset(-1, -1).Address
  66.                                                     P = P + 1
  67.                                                 Case Is = Range(Ad).Offset(-1, 0).Address
  68.                                                     P = P + 1
  69.                                                 Case Is = Range(Ad).Offset(-1, 1).Address
  70.                                                     P = P + 1
  71.                                                 Case Is = Range(Ad).Offset(0, -1).Address
  72.                                                     P = P + 1
  73.                                                 Case Is = Range(Ad).Offset(0, -1).Address
  74.                                                     P = P + 1
  75.                                                 Case Is = Range(Ad).Offset(1, -1).Address
  76.                                                     P = P + 1
  77.                                                 Case Is = Range(Ad).Offset(1, 0).Address
  78.                                                     P = P + 1
  79.                                                 Case Is = Range(Ad).Offset(1, 1).Address
  80.                                                     P = P + 1
  81.                                             End Select
  82.                                         End If
  83.                                         Q = Q + P
  84.                                     Next L
  85.                                     If Q = 1 Then GoTo skip1
  86.                                 End If
  87.                                 K = K + J
  88.                             Next G
  89.                             If K < 8 Then GoTo skip1
  90.                             N = N + 1
  91.                             If tt = vbYes Then
  92.                                 Rng(A).Interior.Color = vbRed
  93.                                 Rng(B).Interior.Color = vbRed
  94.                                 Rng(C).Interior.Color = vbRed
  95.                                 Rng(D).Interior.Color = vbRed
  96.                                 Rng(E).Interior.Color = vbRed
  97.                                 ask = MsgBox("检测结果,是继续,否退出程序", vbYesNo)
  98.                                 Rng(A).Interior.Color = xlNone
  99.                                 Rng(B).Interior.Color = xlNone
  100.                                 Rng(C).Interior.Color = xlNone
  101.                                 Rng(D).Interior.Color = xlNone
  102.                                 Rng(E).Interior.Color = xlNone
  103.                                 If ask = vbNo Then Exit Sub
  104.                             End If
  105.                         End If
  106.                     End If
  107. skip1:
  108.                 Next E
  109.                 End If
  110.             Next D
  111.             End If
  112.         Next C
  113.         End If
  114.     Next B
  115.     End If
  116. Next A
  117. Application.ScreenUpdating = True
  118. MsgBox "共找到 " & N & " 种组合", vbOKOnly, ""
  119. End Sub

查找和判断单元格相邻并且相加和等于25.rar
关于查找和判断单元格相邻并且相加和等于25的解题思路分享.rar
查找和判断单元格相邻并且相加和等于25_07版.rar
2楼
rongjun		 学习K版代码

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素， 经与ExcelTip.Net站长Apolloh商议并征得其同意， 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示， 供有需要的人士查询使用，也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议， 可与本人沟通提出，或于本站点留言，我们会尽快处理。 在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

猜您喜欢
评论列表
搜索

鄂ICP备2021011689号-2

powered by emlog pro Theme By 蓝叶

sitemap