ExcelのVBAループを使用して、Ifステートメントに基づいて図形を挿入するセル範囲

Question

パフォーマンスが低下していることを示すために、逆三角形をセルに逆さまに追加しようとしています。たとえば、セルB5が0より小さい場合は、逆さまの赤い三角形をセルB3に挿入します。 B5が0より小さい場合はB3に挿入する形状を得ることができましたが、今度はC3 & C5、D3 & D5、E3 & E5、M列まで。それだけでなく、スプレッドシートのさらに多くの行でこれを行う必要があります。 セルが0より小さいかどうかを確認して、セル（行、列）に逆さまの赤い三角形を追加するように、マクロとループを各行と列に作成するにはどうすればよいですか？

Sub Add_negative_Triangle() 


'Adds Red Triangle to a Cell to indicate a decrease when corresponding cell if of a certain value 

    Dim SSLeft As Double 
    Dim SSRight As Double 
    Dim SSTop As Double 
    Dim SSWidth As Double 
    Dim SSHeight As Double 
    Dim SS As Range, N As Long 
    Dim z As Integer 
    Dim shpIsoscelesTriangle As Shape 
    Set SS = Range("B3:M3") 
    z = 0 
    SSLeft = SS.Left 
    SSTop = SS.Top 
    SSHeight = SS.Height 
    SSWidth = SS.Width 



    If Range("B5:M5") <= z Then 
     ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, SSLeft, SSTop, 11, 13).Select 

    End If 


If Range("B5:M5") <= z Then 
With Selection.ShapeRange.Fill 
     .Visible = msoTrue 
     .ForeColor.RGB = RGB(205, 0, 0) 
     .Transparency = 0 
     .Solid 
End With 



              End If 

If Range("B5:M5") <= z Then 


With Selection.ShapeRange.Line 
     .Visible = msoTrue 
     .ForeColor.RGB = RGB(205, 0, 0) 
     .Transparency = 0 
    End With 
              End If 


Selection.ShapeRange.Rotation = 180 
Selection.ShapeRange.IncrementLeft 1.5 
Selection.ShapeRange.IncrementTop 1.5 





End Sub 

Answer 1

これは2行以上のセルが負の値を持つB5:M5内のすべてのセルにあなたの三角形の形状を追加します。実際にはどの範囲にも適用できます（3行目から開始）。

Sub Add_negative_Triangle() 
    Dim ss As Range, shp As Shape 
    For Each ss In ActiveSheet.Range("B5:M5") 
     If ss.offset(-2).value < 0 Then 
      Set shp = ss.Parent.Shapes.AddShape(msoShapeIsoscelesTriangle, ss.Left, ss.Top, 11, 13) 
      With shp.Fill 
       .Visible = msoTrue 
       .ForeColor.RGB = RGB(205, 0, 0) 
       .Transparency = 0 
       .Solid 
      End With 
      With shp.line 
       .Visible = msoTrue 
       .ForeColor.RGB = RGB(205, 0, 0) 
       .Transparency = 0 
      End With 
      shp.Rotation = 180 
      shp.IncrementLeft 1.5 
      shp.IncrementTop 1.5 
     End If 
    Next 
End Sub 

Answer 2

それを私にビートこの

Sub Add_negative_Triangle() 

'Adds Red Triangle to a Cell to indicate a decrease when corresponding cell if of a certain value 

    Dim SSLeft As Double 
    Dim SSRight As Double 
    Dim SSTop As Double 
    Dim SSWidth As Double 
    Dim SSHeight As Double 
    Dim SS As Range, N As Long 
    Dim z As Integer 
    Dim shpIsoscelesTriangle As Shape 
    Dim r As Range 
    Dim s As Shape 

    Set SS = Range("B3:M3") 
    z = 0 

    For Each r In SS 
     SSLeft = r.Left 
     SSTop = r.Top 
     SSHeight = r.Height 
     SSWidth = r.Width 

     If r.Offset(2) <= z Then 
      Set s = ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, SSLeft, SSTop, 11, 13) 
      With s.Fill 
       .Visible = msoTrue 
       .ForeColor.RGB = RGB(205, 0, 0) 
       .Transparency = 0 
       .Solid 
      End With 
      With s.Line 
       .Visible = msoTrue 
       .ForeColor.RGB = RGB(205, 0, 0) 
       .Transparency = 0 
      End With 
      s.Rotation = 180 
      s.IncrementLeft 1.5 
      s.IncrementTop 1.5 
     End If 
    Next r 

End Sub