excel矩阵数据在工作表中绘制线条?
发布时间:2022-11-26 11:20:01
Q:如下所示,左侧是一个4行4列的数值矩阵,要使用VBA根据这些数值绘制右侧的图形。
绘制规则是这样的:找到最小的数值(忽略),将其与第2小的数值用点划线连接,再将第2小的数值与第3小的数值用点划线连接,依此类推,直到连接到最大的数值。在连接的过程中,遇到不连接,如果两个要连接的数值之间有其他数,则从这些数值上直接跨过。如所示,连接的顺序是1-2-3-4-5-6-7-8-9-1 -11-12-13。
A:VBA代码如下:
‘在Excel中使用VBA连接单元格中的整数
‘输入: 根据实际修改rangeIN和rangeOUT变量
‘ rangeIN – 包括数字矩阵的单元格区域
‘ rangeOUT – 输出区域左上角单元格
Sub ConnectNumbers()
Dim rangeINAs Range, rangeOUT As Range
Dim cellPrev As Range
Dim cellNext As Range
Dim cell AsRange
Dim i AsInteger
Dim arrRange() As Variant
Set rangeIN= Range(“B3:E6”)
Set rangeOUT = Range(“H3”)
‘删除工作表中已绘制的形状
DeleteArrows
ReDim arrRange( )
‘在一维数组中存储单元格区域中所有大于的整数
For Each cell In rangeIN
Ifcell.Value > And _
IsNumeric(cell.Value) And _
cell.Value = Int(cell.Value) Then
‘仅存储整数
ReDim Preserve arrRange(i)
arrRange(i) = cell.Value
i =i + 1
End If
Next cell
‘排序数组(使用冒泡排序)
Call BubbleSort(arrRange)
‘遍历数组,找到单元格区域相应单元格
For i =LBound(arrRange) To UBound(arrRange) – 1
Set cellPrev = rangeIN.Find(arrRange(i), _
LookIn:=xlValues, LookAt:=xlWhole)
Set cellNext = rangeIN.Find(arrRange(i + 1), _
LookIn:=xlValues, LookAt:=xlWhole)
‘rangeOUT相对于rangeIN合适的偏离来绘制形状
Call DrawArrows(cellPrev.Offset( _
rangeOUT(1, 1).Row – rangeIN(1, 1).Row, _
rangeOUT(1, 1).Column – rangeIN(1, 1).Column), _
cellNext.Offset(rangeOUT(1, 1).Row – rangeIN(1, 1).Row, _
rangeOUT(1, 1).Column – rangeIN(1, 1).Column))
Next i
End Sub
‘冒泡排序法
Sub BubbleSort(MyArray() As Variant)
‘从小到大排序
Dim i As Long, j As Long
Dim Temp As Variant
For i =LBound(MyArray) To UBound(MyArray) – 1
For j =i + 1 To UBound(MyArray)
If MyArray(i) > MyArray(j) Then
Temp = MyArray(j)
MyArray(j) = MyArray(i)
MyArray(i) = Temp
End If
Next j
Next i
End Sub
‘从一个单元格中心绘制到另一个单元格中心的线条
Private Sub DrawArrows(FromRange As Range, ToRange As Range)
Dim dleft1 As Double, dleft2 As Double
Dim dtop1 As Double, dtop2 As Double
Dim dheight1 As Double, dheight2 As Double
Dim dwidth1As Double, dwidth2 As Double
dleft1 =FromRange.Left
dleft2 =ToRange.Left
dtop1 =FromRange.Top
dtop2 =ToRange.Top
dheight1 =FromRange.Height
dheight2 =ToRange.Height
dwidth1 =FromRange.Width
dwidth2 =ToRange.Width
ActiveSheet.Shapes.AddConnector(msoConnectorStraight, _
dleft1+ dwidth1 / 2, dtop1 + dheight1 / 2, _
dleft2+ dwidth2 / 2, dtop2 + dheight2 / 2).Select
‘格式化线条
With Selection.ShapeRange.Line
.BeginArrowheadStyle = msoArrowheadOval
.EndArrowheadStyle = msoArrowheadOval
.DashStyle = msoLineDash
.Weight= 1.75
.ForeColor.RGB = RGB( , , )
End With
End Sub
‘删除所有形状
Sub DeleteArrows()
Dim shp AsShape
For Each shp In ActiveSheet.Shapes
If shp.Connector = msoTrue Then
shp.Delete
End If
Next shp
End Sub


猜你喜欢
- AirPods Pro 拥有三套不同的耳塞,可以实现不同的贴合性。最新的 iOS 13.2 还上线了简单的贴合度测试功能,使用内部麦克风检测
- 这篇文章主要介绍了win10以太网未识别配置怎么办?win10以太网未识别配置的解决办法的相关资料,需要的朋友可以参考下本文详细内容。win
- 用Word文档操作中,如果文档页数较多时,我们会制作目录方便查找,那么怎么我们操作可以自动生成目录呢?下面我们来学习目录的制作技巧。第一步,
- Win7的窗口有各种各样的颜色,当然也有不少用户想自己设置窗口颜色,其实操作方法非常简单,下面以图文的形式为大家介绍下设置窗口颜色混合器教程
- 随着科技的发展,人们的生活以及工作都越来越离不开电脑,在生活上,电脑在给人们带来娱乐的同时还给人们带来了很多便利之处,在工作上,电脑的出现为
- 在我们的电脑中,总是存在着各种各样的插件,这些插件可以帮助我们使用许多功能,方便我们的使用。今天小编向大家推荐一款功能强大的增强插件——Un
- 怎么制作印章呢?有些用户可能给电子文档加上印章,那么如何制作自己想要的印章?下面给大家介绍使用Photoshop软件制作印章的方法。操作步骤
- Adobe Acrobat Pro DC 2019 for Mac是由Adobe公司推出的PDF专业制作与编辑软件,全球有超过500万家组织
- 当我们希望用户只能在wps表格里输入指定的信息,应该如何设置呢?下面就让小编告诉你wps表格设置输入指定信息 的方法。wps表格设置输入指定
- 介绍excel、word等office软件单击超链接出现“由于本机的限制,该操作已被取消,请与系统管理员联系”的解决方法.有时候我们在wor
- 码字精灵是专门为码字而生的一款打字软件,在平时的生活中,相信大家都会用到,那你知道码字精灵怎么添加码字任务的吗?接下来我们一起往下看看码字精
- 通过按两下Mac键盘上的FN键来启动OS X系统的听写功能,但也可以通过语音命令实现免提听写,那么怎么使用呢?下面就为大家介绍下载具体的操作
- 在wps表格中可以设置打印选项的,你知道怎么做吗?下面小编就为你介绍如何打印wps表格的方法啦!打印wps表格的方法1、在左上角“WPS文字
- excel是我们常用的办公软件,有时会用到打印功能,那么excel如何调整打印预览的大小?下面小编带来打印预览调整大小的设置方法,希望对大家
- 有很多PPT爱好者留言给我,问我的PPT中的图片是从哪里下载的?这也是个比较普遍的问题。Fish今天就与大家分享一下我经常下载的几个网站,只
- Genius 播放列表可让您发现新音乐。它使用巧妙的技术为您创建 Genius 组合。您在 Mac 上创建了这样一个 Genius 播放列表
- 发图狂魔怎么制作DIY图片?发图狂魔是一款表情包软件,用户们不但能够在APP上找到各式各样的表情包,还可自己制作DIY图片,那么具体该如何操
- 有网友问自己的电脑黑屏只有鼠标箭头进不去,电脑屏幕全黑只有鼠标,电脑黑屏只有鼠标箭头怎么办?只看到屏幕上面有一个鼠标图标可以移动,遇到这样的
- 很多小伙伴打开笔记本电脑任务管理器cpu时候,发现磁盘显示百分之100,这是怎么一回事呢?因为当Windows Defender在进行扫描时
- 当我们将鼠标停留在任务栏图标上就会显示出预览窗口,方便用户查看一些任务的运行状态,但是有用户觉得预览窗口太大了,有什么方法可以修改任务栏预览