Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

32430 / 76734

←次へ　｜　前へ→


	【49540】円作成

シスアド - 07/6/9(土) 21:40 -


	引用なし

	パスワード

以前投稿させていただき教えていただいたのですが
マクロ関数がよくわかりません。よろしければ
わかるかた説明していただけないでしょうか？

あと、このマクロでは、データが入ってると新規でｼｰﾄが作成され
データによって円が作成されるのですが、ﾌｫｰﾏｯﾄというｼｰﾄを利用して
その上に円が作成されるようにしたいのですができますでしょうか？

Option Explicit
Sub sample()
　　Dim BKdx As Variant
　　Dim BJdx As Variant
　　Dim c As Range
　　Dim BKarray As Variant
　　Dim BJarray As Variant
　　BKarray = Evaluate( _
　　　　　　　　 "transpose({0,1,2,3;" & _
　　　　　　　　 "159.75,249.75,343.75,432.75;" & _
　　　　　　　　 "29.25,157.25,29.25,29.25})")
　　BJarray = Evaluate( _
　　　　　　　　 "transpose({0,1,2,3;" & _
　　　　　　　　 "100,150,200,250;" & _
　　　　　　　　 "30,100,80,25})")
　　'↑これが、ＢＫ列、ＢＪ列の数値に対応する円の作成位置を表すマスターデータです。
　　'本来なら、シート上に配置するのが良いと思います。そうすれば、データの変更や追加があっても
　　'コードの変更が要りません
　　With Worksheets("sheet1")
　　　 For Each c In .Range("bk2", .Cells(.Rows.Count, "bk").End(xlUp))
　　　　　With Application
　　　　　　 BKdx = .Match(Val(c.Value), .Index(BKarray, 0, 1), 0)
　　　　　　 End With
　　　　　With Application
　　　　　　 BJdx = .Match(Val(c.Offset(0, -1).Value), .Index(BJarray, 0, 1), 0)
　　　　　　 End With
　　　　　If (Not IsError(BKdx)) Or (Not IsError(BJdx)) Then
　　　　　　 With Worksheets.Add(after:=Worksheets(Worksheets.Count))
　　　　　　　　　.Name = "sheet" & c.Row
　　　　　　　　　DoEvents
　　　　　　　　　If Not IsError(BKdx) Then
　　　　　　　　　　 With .Shapes.AddShape(msoShapeOval, _
　　　　　　　　　　　　　 BKarray(BKdx, 2), BKarray(BKdx, 3), 15.75, 15.75)
　　　　　　　　　　　　.Fill.Visible = msoFalse
　　　　　　　　　　　　End With
　　　　　　　　　　 End If
　　　　　　　　　If Not IsError(BJdx) Then
　　　　　　　　　　 With .Shapes.AddShape(msoShapeOval, _
　　　　　　　　　　　　　 BJarray(BJdx, 2), BJarray(BJdx, 3), 15.75, 15.75)
　　　　　　　　　　　　.Fill.Visible = msoTrue
　　　　　　　　　　　　.Fill.ForeColor.SchemeColor = 15
　　　　　　　　　　　　.Fill.Transparency = 0.51
　　　　　　　　　　　　End With
　　　　　　　　　　 End If
　　　　　　　　　End With
　　　　　　 End If
　　　　　Next
　　　 End With
End Sub

2 hits

▼

【49540】円作成 シスアド 07/6/9(土) 21:40

≪