|
▼シスアド さん:
おはようございます。
>すいません、もう1つ教えてもらいたいのですが
>
> A B ・・ BJ ・・ BK
> 1 作成位置指示2 作成位置指示
> 2 3 1
> 3 2 2
> 4 1 0
> 5 2 3
> 6 2 1
> 7 3 2
>
>上記のように作成位置指示2を追加して、BKで作成したsheet名とそれぞれ同じsheetにBJの円作成ができないでしょうか?
>これは、BKでつくったsheet上に追加するんではなく、同時BJ・BK同時に円を作成したいのですが。。。
>BJの円作成位置は適当に決めてもらってかまいません。
いいえ、これもシスアド さん本来は、記述してください。
>>
>>・新規ブックにシートを1枚のみにしてください。
>> (既定で、3枚作成されていても削除して1枚にしてください)
>>
>>・この1枚シートのシート名はSheet1としてください。
>> このシートのセルBK2以降に円の作成指示番号が入っているとします。
↑この前提は、今回も同じです
上記のような新規ブックの標準モジュールに
'===============================================================
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})")
'↑これが、BK列、BJ列の数値に対応する円の作成位置を表すマスターデータです。
'本来なら、シート上に配置するのが良いと思います。そうすれば、データの変更や追加があっても
'コードの変更が要りません
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
>>
BK列、BJ列に円の作成位置データを配置し(それぞれ2行目から)、
>>上記のSampleを実行してみてください。
尚、作成位置データの入力範囲は、BK列を基準に取得しています。
大きく、コードを変更しました。
当初は、シスアド さんのコードを少しでも残す方向でコードを書きましたが、
本来なら、今回のような事象では、私は、Case文を使いません。
(コードの変更をなるべく少なくしたい という理由からです)
試してみてください。そして、コードは、前回より、難しいですが、
HELP等を使ってじっくり解読してください。
特に配列とワークシート関数の知識が必要です。
その上で不明な点があれば今度は、ピンポイントで質問してください。
|
|