| |
▼シスアド さん：
おはようございます。
>すいません、もう１つ教えてもらいたいのですが
>
> Ａ Ｂ ・・ ＢＪ ・・ ＢＫ
> 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の円作成ができないでしょうか？
>これは、ＢＫでつくったsheet上に追加するんではなく、同時ＢＪ・ＢＫ同時に円を作成したいのですが。。。
>ＢＪの円作成位置は適当に決めてもらってかまいません。
いいえ、これもシスアド さん本来は、記述してください。
>>
>>・新規ブックにシートを１枚のみにしてください。
>> （既定で、３枚作成されていても削除して１枚にしてください）
>>
>>・この１枚シートのシート名は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})")
'↑これが、ＢＫ列、ＢＪ列の数値に対応する円の作成位置を表すマスターデータです。
'本来なら、シート上に配置するのが良いと思います。そうすれば、データの変更や追加があっても
'コードの変更が要りません
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
>>
ＢＫ列、ＢＪ列に円の作成位置データを配置し（それぞれ２行目から）、
>>上記のSampleを実行してみてください。
尚、作成位置データの入力範囲は、ＢＫ列を基準に取得しています。
大きく、コードを変更しました。
当初は、シスアド さんのコードを少しでも残す方向でコードを書きましたが、
本来なら、今回のような事象では、私は、Case文を使いません。
（コードの変更をなるべく少なくしたい という理由からです）
試してみてください。そして、コードは、前回より、難しいですが、
HELP等を使ってじっくり解読してください。
特に配列とワークシート関数の知識が必要です。
その上で不明な点があれば今度は、ピンポイントで質問してください。
|
|
ichinose
- 07/5/14(月) 8:59 -
