本文作者:office教程网

excel矩阵数据在工作表中绘制线条?

office教程网 2024-01-12 07:07:26
后台-系统设置-扩展变量-手机广告位-内容正文顶部
摘要:

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

‘冒泡排序法

十个excel数据输入技巧,助你效率提升十倍!

今天,给大家十个小技巧,都是数据输入方面的,仅仅是数据输入方面哦!学会了,你的录入效率会提高十倍,甚至更多,不信,你来试试!! 来,上技巧大餐: 1.内置序列批量填充 此输入方式,前提是需要填充的数据,在“自定义序列”里已经存在。如下图: 也可以把自己常用的系列数据添加到“自定义序列”。 2数字中文大

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函数#2.“威力强大”的Index函数

以我的观点看,INDEX函数是Excel中最重要的一个工作表函数。 现在看来,考虑该函数单调的名字是令人惊讶的。那么,什么使INDEX函数如此强大呢?它是非易失性的、明快的、灵活的并且用途广泛。INDEX可以返回一个值或者一组值,可以返回对某个单元格的引用或者单元格区域的引用。INDEX可以很好地结合三个引用操作符(

后台-系统设置-扩展变量-手机广告位-内容正文底部
未经允许不得转载:

作者:office教程网,原文地址:excel矩阵数据在工作表中绘制线条?发布于2024-01-12 07:07:26
转载或复制请以超链接形式并注明出处 演示站

分享到:

觉得文章有用就打赏一下文章作者

支付宝扫一扫打赏

微信扫一扫打赏

留言与评论(共有 0 条评论)
   
验证码: