兼業主夫 ときどき 指揮者 のち ギーク?

2016-12-07

データの内容に応じてオートシェイプを配置していく

ちょっと聞かれたので、回答用にここにメモ。

「データ」シートに下記のようなデータがあるとする。

AB
1a2
2b3
3c2
4d4
5e1
6f6
7g3

このデータを読み取って、下記要領で「結果」シートに書き込みを行う。

  • 「データ」シートのB列の値を「結果」シートのD列に転記
  • データの転記は3行おき
  • 転記した値を元に、転記した行にオートシェイプを配置する
  • オートシェイプの幅は、転記した値に比例する

色々な書き方が当然あるだろうけれど、ざっくり作ってこんな感じでいかがでしょうか。

Sub main()
Dim row As Long

    row = 1
    
    With Sheets("データ")
        Do Until .Range("A" & row).Value = ""
            Call setShape(.Range("B" & row).Value, row)
            row = row + 1
        Loop
    End With
End Sub

Private Sub setShape(v As Long, dataRow As Long)
Dim shapeRow    As Long
Dim shapeTop    As Long
Dim shapeLeft   As Long
Dim ShapeWidth  As Long
Dim shapeHeight As Long

    shapeRow = ((dataRow - 1) * 3) + 1

    With Sheets("結果")
        shapeTop = .Range("E" & shapeRow).Top + 3
        shapeLeft = .Range("E" & shapeRow).Left + 5
        ShapeWidth = v * 10
        shapeHeight = 6.75
        
        .Range("D" & shapeRow).Value = v
        .Shapes.AddShape(msoShapeRectangle, shapeLeft, shapeTop, ShapeWidth, shapeHeight).Select
    End With
End Sub

なお、棒グラフ的なものを表示したいという場合には、Excel2007からは「データバー」という機能があるので、そちらを使うことをお勧めしておく。

投稿したコメントは管理者が承認するまで公開されません。

スパム対策のためのダミーです。もし見えても何も入力しないでください
ゲスト


画像認証

トラックバック - http://d.hatena.ne.jp/hiko_s/20161207/p1