excel矩阵数据怎么绘制线条
发布时间:2022-11-07 09:58:44
excel矩阵数据怎么绘制线条
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
猜你喜欢
- excel中有很多可以表示数据的图,有柱状图、折线图、饼图,一般表示百分比的都是用饼图,下面小编就为大家介绍excel绘制一个半圆的饼图方法
- 平时工作中我经常用wps Office办公软件制作各种表格,正好这两天工作不是很忙,赶紧就把自己使用WPS表格过程中发现的几个小技巧整理了一
- 不能错过的36个excel使用技巧1、一列数据同时除以10000复制10000所在单元格,选取数据区域 - 选择粘性粘贴 - 除  
- word 2010 中更改文字字体和大小,编辑标准文档必须用到一项功能,一起来看看怎么设置吧。首先选中想要更改的文字,点击“字体”中的“字号
- 快速地在不同的视图之间进行切换,可以提高工作效率。以下简单介绍切换不同的视图的具体操作步骤。切换至“视图”选项卡,在“工作簿视图”组中选择一
- Win10怎么使用命令卸载IE浏览器?Win10系统怎么卸载IE浏览器?IE作为一款历史悠久的浏览器更新了很多很多个版本,作为微软内置的浏览
- 在我们日常工作学习中,我们经常会需要用到Excel表格工具的一些功能,Excel的合并计算不仅可以进行求和汇总,还可以进行求平均值、计数统计
- Excel中的首行首列具体该如何进行冻结呢?接下来是小编为大家带来的excel2003冻结首行首列的方法,供大家参考。excel2003冻结
- word中怎么将彩色的图片变成黑白色的?word中的照片想换成黑白色的,不知道该怎么做,其实很简单,只要调节一下灰度就好了,下面我们来看看w
- 相信大家在使用电脑的时候都遇到过电脑因为各种各样的问题卡住,鼠标都动不了了的情况。一般电脑卡住只要重新开机重启就好了,但是这种情况鼠标动不了
- 关键操作提示:判断A列年份是否为闰年,公式为:=IF(OR(AND(MOD(A2,4)=0,MOD(A2,100)<>0),MO
- 一、获取目标分区下的文档信息能够提取指定分区或文件夹下所有文件的名称、类型、大小等信息的软件很多,这里选择的是PrintFolder Pro
- 虚拟桌面是Win10专业版系统十分强大的一个功能。当用户在电脑上打开不同软件时,它就能帮助我们在电脑桌面上同时进行多个任务,让我们可以在这些
- 下面为大家分析分享新建的excel表格无法打开提示因为文件格式无效的解决办法方法1、打开用户的电脑系统盘,一般为C盘,找到路径:C:\Win
- 选中段落——鼠标右键——段落——缩句和间距——在间距中找到行距,然后选择1.5倍行距即可
- 在 Excel 单元格里直接输入数字、日期或文本,以及相关的运算符编写公式并求值。除了直接输入数据编写公式外,可以引用工作簿上的单元格编写公
- 在word打印的时候往往需要打印成a4,那么如何设置word2007的纸张大小为a4呢?下面就由小编为您解答,希望能帮助您。word07a4
- 在很多用户看来,Office 的安装与管理还是一个技术活。其实除了常见的安装方式外,微软也提供了一款供专业人士部署的工具:Office De
- 我们日常办公时,几乎每天都会接触到WORD文件,有时会遇到已经加密WORD文档或者自己加密而忘了密码的情况。下面让小编为你带来word如何破
- Word对于我们办公来说,是不可缺少的办公软件,因为没有它我们可能无法进行许多任务。所以现在的文员和办公室工作的人,最基础的就是会熟悉的使用