施工资料
用户
【工程应用】工程质量验收检验数值超标..
发布时间:2021-02-16 13:27:26 浏览:452次


一、前言

曾经看到一个网友问这个问题:

如何对超标数值自动插入三角符号

意思是黄色单元格内(G:P列)的数值超过这一行最前面的蓝色单元格(F列)时,就在超过的数值所在的单元格标示红色的三角形。

二、功能

代码的功能就是实现对超过超过的数据进行标注,用红色有三角形标注。

在质量评定中,当有数值超过范围时,是用下划线进行标示的,这里是用三角形进行标示的,意思是一样的。

只要修改数据,三角形自动更新!



三、代码

1、晚上临时写了一段代码,发上面共享一下,看看对大家有用不!

OptionExplicit
PrivateSub 标示超标值_Click()Dimi%, j%, n%, k%, m%DimKmax%, Kmin%Dimstr$DimPic As ShapeDimrngtop%, rngleft%, rngwid%, rnghig%
OnError Resume Next
''删除原三角形ForEach Pic In ActiveSheet.ShapesIfPic.Name Like "AutoShape*" ThenPic.DeleteEndIfNext
Fori = 17 To 108 ''32''行str = Cells(i, 6).Valuestr = Replace(str, "mm", "")n = InStr(1, str, ",")m = InStr(1, str, "±")Ifn > 0 ThenKmax = Left(str, n - 1)Kmin = Mid(str, n + 1, Len(str))ElseIfn = 0 ThenIfm > 0 Thenstr = Replace(str, "±", "")Kmax = strKmin = -strElseIfm = 0 ThenKmax = Left(str, Len(str))EndIfEndIf
Forj = 7 To 16 ''列IfCells(i, j) <> "" Thenk = Cells(i, j).ValueIfk > Kmax Or k < Kmin Then''画三角形rngtop = Cells(i, j).Toprngwid = Cells(i, j).ColumnWidthrngleft = Cells(i, j).Left + rngwidrnghig = Cells(i, j).RowHeight / 2 - 9.75 / 2

ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle,


rngleft + rngwid, rngtop + rnghig, 11.25, 9.75).Select

Selection.ShapeRange.Line.ForeColor.SchemeColor = 10Selection.ShapeRange.Line.Visible = msoTrueSelection.ShapeRange.Fill.Visible = msoFalseCells(i,j).Select
EndIfEndIfNextjNexti
End Sub


2、增加的代码,只要修改数据,三角形自动更新:

Private Sub Worksheet_Change(ByVal Target As Range)    Dim mm%    mm = Target.Value    If Target.Column >= 7And Target.Column <= 16 Then        If IsNumeric(mm) Then            Call 标示超标值_Click        End If    End If    Target.SelectEnd Sub
以下是《【工程应用】工程质量验收检验数值超标..》的详细资料:
资料作者:  
发布日期:2021-02-16 13:27:26
总浏览量:452
总下载量:
运行环境:  
资料语音: 简体中文 
资料大小: 58KB 
下载地址: 工程检验批质量验收记录表    
上一篇没有了
下一篇长沙市水务工程施工质量验收评定..
';?>