|
发表于 2015-3-28 11:23
|
显示全部楼层
本楼为最佳答案
Sub Macro1()
Dim rng As Range, i&
For Each m In ActiveSheet.Shapes
If Not Application.Intersect([h20:q31], m.TopLeftCell) Is Nothing Then
If m.Type <> 8 Then m.Delete
End If
Next
For i = 20 To 31
tj = Cells(i, 6)
If InStr(tj, "±") Then
x = Val(Mid(tj, 2))
For j = 8 To 17
s = Cells(i, j)
If Not (s <= x And s >= 0 - x) Then GoSub 100
Next
ElseIf InStr(tj, "<") Then
x = Val(Mid(tj, 2))
For j = 8 To 17
s = Cells(i, j)
If Not s < x Then GoSub 100
Next
ElseIf InStr(tj, ">") Then
x = Val(Mid(tj, 2))
For j = 8 To 17
s = Cells(i, j)
If Not s > x Then GoSub 100
Next
ElseIf InStr(tj, "~") Then
x = Split(tj, "~")
For j = 8 To 17
s = Cells(i, j)
If Not (s >= Val(x(0)) And s <= Val(x(1))) Then GoSub 100
Next
ElseIf InStr(tj, ";") Then
x = Split(tj, ";")
For j = 8 To 17
s = Cells(i, j)
If Not (s <= Val(x(0)) And s >= Val(x(1))) Then GoSub 100
Next
Else
x = Val(tj)
For j = 8 To 17
s = Cells(i, j)
If Not s <= x Then GoSub 100
Next
End If
Next
If Not rng Is Nothing Then
For Each m In rng
X1 = m.Left + m.Width * 0.25
Y1 = m.Top + m.Height * 0.25
X2 = m.Width * 0.5
Y2 = m.Height * 0.5
With ActiveSheet.Shapes.AddShape(msoShapeOval, X1, Y1, X2, Y2)
.Fill.Transparency = 1
.Line.ForeColor.SchemeColor = 10
.Line.Weight = 1
End With
Next
End If
[a33] = "共实测 110 点,其中合格 " & 110 - rng.Count & " 点,不合格 " & rng.Count & " 点,合格率 " & Round((110 - rng.Count) * 100 / 110, 2) & "%"
Exit Sub
100:
If rng Is Nothing Then Set rng = Cells(i, j) Else Set rng = Union(rng, Cells(i, j))
Return
End Sub
|
|