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
猜你喜欢
- 学习群里的朋友提出的问题,如下样表:规格型号一列的算式,既有各种单位又有小数点,怎么计算结果?方法实现像这种除了数值以外,还有很复杂的数量单
- win7鼠标右键没反应怎么处理?最近有用户反映自己的win7鼠标在使用的过程中会突然失灵,所有需要右击的选项都是没有办法点击的,让自己没法更
- 用户在使用Word2013打开Word2010创建的.docx文档时会显示“兼容模式”,说明当前打开的Word2010文档有可能无法支持Wo
- 很多用户认为在使用win10系统时,右击桌面经常会卡住,win10卡住是兼容性问题。用鼠标右键点击桌面并转过身,然后黑色或白色屏幕将闪烁,它
- 在Word2007文档中高级应用之“域”,我们知道了域的插入与更新,而现在我们要更上一层楼,学习如何编辑域。域在Word2007中是起到数据
- word怎么绘制一个真实立体的铁盒?1、新建word文档;在文档的绘图工具栏中点击“矩形”; 2、在文档上画出图形
- 《Excel2003入门动画教程63、Excel中图标的制作与建立》。演示动画 操作步骤Excel除了具有强大的数
- win10游戏文档文件在哪?win10有自带的游戏,那么这些游戏藏在哪里呢。就在游戏文档里,根据不同的用户存储在各自的目录下。需要找到这个保
- 目前Win7和Win10系统都是使用最多的,有很多Win7的用户已经升级到Win10了,有的用户还在纠结有没有必要升级,其实从2020年1月
- Excel表格混合文本怎么统计数据之和?excel表格中有文本有数据,想要同居数据的和,该怎么统计呢?下面我们就来看看详细的教程,需要的朋友
- 一般情况下,wps开始工具栏都会直接显示在文档上的,若是隐藏了,显示的方法如下:1、在打开的wps界面的右上角,可以看到一个倒立V的图标,点
- 《Excel2003入门动画教程36、设置Excel默认打开文件夹路径》。演示动画 操作步骤默认情况下,在Exce
- word不显示批注怎么办?Word如何隐藏与显示批注首先打开Word文档需要批注的。小编这里以“家用电脑”Word文档中批注一下。在菜单中执
- win10重启FLTMGR.SYS蓝屏的原因是软件发生冲突,实际上一般的解决方法是进入系统,卸载该软件进行清扫即可,因为用户设置的第三方软件
- 大家在使用Office2013写Word文档的时候,想给Word文档里的文字插入图片背景,但是很多人都不知道应该怎么操作,只要在Office
- Excel文件打不开提示文件已损坏该怎么办?在工作群众下载了excel文件,结果却打不开,没事打开都会出现提示:该文件已损坏,无法运行这是怎
- 启动WPS表格程序,点击程序左上角【WPS表格】选项旁边的【小倒三角形】符号。在点击【小倒三角形】后弹出的菜单下点击选择【工具】-->
- 设置艺术字效果为了让插入的艺术字更美观,用户还可以设置其特殊效果,包括阴影、映像、发光、棱台等,下面将对其具体操作进行介绍。若设置艺术字的阴
- 在有些时候我们的word提示内存不足,这时候该怎么办呢?对于新手来说还是有一定难度,怎么办?那么下面就由小编来给你们说说word提示内存不足
- Q:我知道在Word里可以改变文本的排列方向,使其由横向排列改为纵向排列,但是有没有什么法子能旋转文本,使其以与水平线呈30度的角度排列?我