ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 4331|回复: 11

[分享] [分享与求助]类技术的应用学习实例——数图形中的三角形

[复制链接]

TA的精华主题

TA的得分主题

发表于 2013-11-14 14:50 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:类和类模块
近日遇到一个数三角形的题目,如下表左边的图形。按照的方法可以人工数出来,但也想用电脑偷下懒,于是萌生了写个代码的想法。 2013-11-14_142338.png
最先开始想用数组与字典来完成,但那样感觉逻辑性不强且与实际图形不好联系,于是采用了自定义类的方法,也算是学习的一个实例。
于是一步步写下来创建了4个类(点、线、图形、三角形),如下图:
2013-11-14_142358.png

最终经过一路磕磕绊绊还算是完成了。分享一下该文件,如有需要在家辅导孩子的朋友可以直接使用,使用时,只需要从A2开始依次往下输入图形中每条线段的信息——线段上的点,用英文逗号隔开。然后单击按钮即可。

另外,还有问题想求助:类中的集合能否做到指定集合元素类型?
比如代码中的clsShape中的vLines集合,这个集合是clsLine对象的集合,但是在引用其中对象时并不能在输入  .  后自动列出成员,我想如果可以定义其类型为clsLine的话, 应该可以自动列出成员。


希望知道的朋友分享一下,谢谢!




该贴已经同步到 Moneky的微博

数三角形.rar

43.58 KB, 下载次数: 110

TA的精华主题

TA的得分主题

发表于 2013-11-14 15:19 | 显示全部楼层
图形结构固定的话,可以用公式实现

TA的精华主题

TA的得分主题

 楼主| 发表于 2013-11-14 15:48 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 Moneky 于 2013-11-14 23:14 编辑
jsxjd 发表于 2013-11-14 15:19
图形结构固定的话,可以用公式实现

这个程序为的是针对任何数三角形的题目。

至于公式嘛,是知道的。

1楼中的问题已经自己解决了——再专门创建一个clsLines类,封装一个集合,提供添加元素接口,Items属性。后面再把代码更新.


后记:
在尝试创建clsLines类时,已经实现了该集合元素返回clsLine对象——VBE中可自动列出成员,但是无法想集合意义调用clsLines实例名称,如:
dim a as new clsLines
a(2)    ----------------无法像这样调用,结果导致代码看起来繁杂,因此暂时先放弃这种做法了。

TA的精华主题

TA的得分主题

发表于 2014-9-12 15:42 | 显示全部楼层
Moneky 发表于 2013-11-14 15:48
这个程序为的是针对任何数三角形的题目。

至于公式嘛,是知道的。

设置集合类的默认属性为其集合属性

比如 clsLines 里的属性 Lines 是返回 clsLine 的集合,把这个 Lines 属性设置为默认属性。

参考:http://club.excelhome.net/forum. ... &extra=page%3D1

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-9-12 16:47 | 显示全部楼层
lee1892 发表于 2014-9-12 15:42
设置集合类的默认属性为其集合属性

比如 clsLines 里的属性 Lines 是返回 clsLine 的集合,把这个 Lin ...

谢谢lee1892指点,又掌握了一种新技术。

TA的精华主题

TA的得分主题

发表于 2014-9-12 17:42 | 显示全部楼层
另外,我没去看代码,不清楚你的实现算法。

但第一感觉,应该是构建图数据结构,遍历寻找三边回路。应该不需要用到类。

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-9-13 09:25 | 显示全部楼层
lee1892 发表于 2014-9-12 17:42
另外,我没去看代码,不清楚你的实现算法。

但第一感觉,应该是构建图数据结构,遍历寻找三边回路。应该 ...

我的算法是:
记录图形中的线段(包含线段上的所有点)
依次取每条线段中的两个点预定为三角形的两个顶点,再从其它线段中依次取出每一个点,判断如果现在这个点和之前的两个点都在同一条线段的话,这三个点就可以组成一个三角形。

历遍每条线段就得到了所有三角形了。

很原始的想法

TA的精华主题

TA的得分主题

发表于 2014-9-13 11:57 | 显示全部楼层
Moneky 发表于 2014-9-13 09:25
我的算法是:
记录图形中的线段(包含线段上的所有点)
依次取每条线段中的两个点预定为三角形的两个顶 ...

我的算法伪代码如下:
  1. Type 顶点
  2.     名称
  3.     邻接点集合
  4.     与某顶点是否邻接布尔数组
  5. End
  6. 读取原始数据,并构造顶点集合
  7. For Each 顶点1 In 顶点集合
  8.     For Each 顶点2 In 顶点1.邻接点集合
  9.         For Each 顶点3 In 顶点2.邻接点集合
  10.             If 顶点3 可连接 顶点1
  11.                 如果 3 点不在一条直线上,且该三角形未记录,则记录入结果
复制代码
创建类总是很费工夫的,构建合适的数据结构会使得算法非常简洁。

TA的精华主题

TA的得分主题

发表于 2014-9-13 12:06 | 显示全部楼层
下面这段代码比较啰嗦,主要是数据初始化稍微麻烦点,我估计1万以内的顶点规模的速度是可以接受的,更大规模的会受字典对象影响了。
你这个题目可以锻炼两方面的内容了
  1. Private Type VERTEX
  2.     Name As String * 1
  3.     Neibours As New Collection
  4.     Linkable() As Boolean
  5. End Type

  6. Private Sub CountTriangles()
  7.     Dim aInput, i%, j%, k%, nInd%, sPnt, aPnts, nPnt1, nPnt2
  8.     Dim aVerts() As VERTEX, dPnts As Object
  9.     Dim dLine As Object
  10.     Dim dTris As Object, nCnt%
  11.     Dim t#
  12.     t = Timer
  13.     ' 图 数据结构初始化
  14.     aInput = Cells(2, 1).Resize(Cells(1, 1).End(xlDown).Row - 1, 1)
  15.     nInd = 0
  16.     Set dPnts = CreateObject("scripting.dictionary")
  17.     Set dLine = CreateObject("scripting.dictionary")
  18.     ReDim aVerts(1 To UBound(aInput) * 3)
  19.     For i = 1 To UBound(aInput)
  20.         aPnts = Split(aInput(i, 1), ",")
  21.         For Each sPnt In aPnts
  22.             If Not dPnts.exists(sPnt) Then
  23.                 nInd = nInd + 1
  24.                 dPnts(sPnt) = nInd
  25.                 If nInd > UBound(aVerts) Then
  26.                     ReDim Preserve aVerts(1 To nInd * 2)
  27.                 End If
  28.                 aVerts(nInd).Name = sPnt
  29.             End If
  30.         Next
  31.         For nPnt1 = 0 To UBound(aPnts) - 2
  32.             For nPnt2 = nPnt1 + 1 To UBound(aPnts) - 1
  33.                 For j = nPnt2 + 1 To UBound(aPnts)
  34.                     sPnt = Array(aPnts(nPnt1), aPnts(nPnt2), aPnts(j))
  35.                     dLine(sPnt(0) & sPnt(1) & sPnt(2)) = 1
  36.                     dLine(sPnt(0) & sPnt(2) & sPnt(1)) = 1
  37.                     dLine(sPnt(1) & sPnt(0) & sPnt(2)) = 1
  38.                     dLine(sPnt(1) & sPnt(2) & sPnt(0)) = 1
  39.                     dLine(sPnt(2) & sPnt(0) & sPnt(1)) = 1
  40.                     dLine(sPnt(2) & sPnt(1) & sPnt(0)) = 1
  41.                 Next
  42.             Next
  43.         Next
  44.     Next
  45.     ReDim Preserve aVerts(1 To nInd)
  46.     For i = 1 To nInd
  47.         ReDim aVerts(i).Linkable(1 To nInd)
  48.     Next
  49.     For i = 1 To UBound(aInput)
  50.         aPnts = Split(aInput(i, 1), ",")
  51.         For j = 0 To UBound(aPnts) - 1
  52.             For k = j + 1 To UBound(aPnts)
  53.                 With aVerts(dPnts(aPnts(j)))
  54.                     .Neibours.Add dPnts(aPnts(k)), aPnts(k)
  55.                     .Linkable(dPnts(aPnts(k))) = True
  56.                 End With
  57.                 With aVerts(dPnts(aPnts(k)))
  58.                     .Neibours.Add dPnts(aPnts(j)), aPnts(j)
  59.                     .Linkable(dPnts(aPnts(j))) = True
  60.                 End With
  61.             Next
  62.         Next
  63.     Next
  64.     ' 遍历查找
  65.     Set dTris = CreateObject("scripting.dictionary")
  66.     nCnt = 0
  67.     For i = 1 To nInd
  68.         For Each nPnt1 In aVerts(i).Neibours
  69.             For Each nPnt2 In aVerts(nPnt1).Neibours
  70.                 If aVerts(nPnt2).Linkable(i) Then
  71.                     aPnts = Array(aVerts(i).Name, aVerts(nPnt1).Name, aVerts(nPnt2).Name)
  72.                     If Not dLine.exists(Join(aPnts, "")) Then
  73.                         If Not dTris.exists(aPnts(0) & aPnts(1) & aPnts(2)) And _
  74.                            Not dTris.exists(aPnts(0) & aPnts(2) & aPnts(1)) And _
  75.                            Not dTris.exists(aPnts(1) & aPnts(0) & aPnts(2)) And _
  76.                            Not dTris.exists(aPnts(1) & aPnts(2) & aPnts(0)) And _
  77.                            Not dTris.exists(aPnts(2) & aPnts(0) & aPnts(1)) And _
  78.                            Not dTris.exists(aPnts(2) & aPnts(1) & aPnts(0)) Then
  79.                             nCnt = nCnt + 1
  80.                             dTris(Join(aPnts, "")) = nCnt
  81.                         End If
  82.                     End If
  83.                 End If
  84.             Next
  85.         Next
  86.     Next
  87.     ' 输出结果
  88.     ReDim aInput(0 To dTris.Count, 0 To 0)
  89.     aPnts = dTris.keys
  90.     aInput(0, 0) = "共 " & dTris.Count & " 个三角形"
  91.     For i = 0 To UBound(aPnts)
  92.         aInput(i + 1, 0) = aPnts(i)
  93.     Next
  94.     Columns(3).ClearContents
  95.     Cells(1, 3).Resize(dTris.Count + 1, 1) = aInput
  96.     ' 清空内存
  97.     dPnts.RemoveAll: Set dPnts = Nothing
  98.     dLine.RemoveAll: Set dLine = Nothing
  99.     dTris.RemoveAll: Set dTris = Nothing
  100.     For i = 1 To UBound(aVerts)
  101.         Set aVerts(i).Neibours = Nothing
  102.         Erase aVerts(i).Linkable
  103.     Next
  104.     Erase aVerts
  105.     Debug.Print Timer - t
  106. End Sub
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-9-13 12:08 | 显示全部楼层
lee1892 发表于 2014-9-13 12:06
下面这段代码比较啰嗦,主要是数据初始化稍微麻烦点,我估计1万以内的顶点规模的速度是可以接受的,更大规模 ...

受教了,代码只有后面再看了,现在上班。谢谢指教!
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 04:49 , Processed in 0.050854 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表