VBA参照セルの範囲をループして範囲を追加

Question

基本的には、Excelでガントチャートを作成しています：各列は1週間を表します。今度はマイルストーンを追加したいと思います。マイルストーンが配信される週の中心に小さなドット（形）を追加することでこれを行いたいと思います。私のデータには、どのセルに配置する必要があるかを指定する1つの列（X）があります。これは行ごとに異なります。スクリーンショットは私が何を意味するかを明確にするはずです。私はそれを1行で行うことができますが、セルX11からX20まで実行するループの構築に問題があります。それが重要かどうかはわかりませんが、すべての行でマイルストーンは必要ありません。一部の行では、列Xのセルが空です。

は、今、私が持っているもの以下であるが、これはエラーを返します。私はなぜ、どのようにこれを修正するのか分かりません。

Sub Bolletjes() 

Const BallSize = 8 
Const FirstColumnKV = "X" 
Const FirstRowKV = 11 

Dim clLeft As Double 
Dim clTop As Double 
Dim clWidth As Double 
Dim clHeight As Double 

Dim findcellKV As Variant 

Dim cl As Range 
Dim shpOval As Shape 
Dim Counter As Integer 

For Counter = FirstRowKV To 20 
findcellKV = Range(FirstColumnKV & Counter).Value 
Set cl = Range(findcellKV) 

clLeft = cl.Left 
clTop = cl.Top 
clOffsetV = cl.Height/2 - BallSize/2 
clOffsetH = cl.Width/2 - BallSize/2 

Set shpOval = ActiveSheet.Shapes.AddShape(msoShapeOval, clLeft + clOffsetH,clTop + clOffsetV, BallSize, BallSize) 
shpOval.Fill.ForeColor.RGB = RGB(152, 52, 7) 
shpOval.Line.ForeColor.RGB = RGB(152, 52, 7) 
shpOval.Line.Weight = 1 

Next 

End Sub 

Answer 1

これはコメントのためには長すぎるようですが、私はこれを答えにします。

まず、値を変更しない場合は、定数Constが使用されます（）。したがって、あなたの目的のために、変数として定義する必要があります。Longが好ましいでしょう。

第2に、IMOはVBAコードでのインデックス文字の使用はそれほど滑らかではありません。セルや列への参照にはインデックス番号を使用してください。追加、増やしたり、他にもたくさんの楽しいことをすることができます。インデックス文字ではできません。あなたのコードについては

：

また

Sub Bolletjes() 

Dim ws as Worksheet 

Dim clLeft As Double 
Dim clTop As Double 
Dim clWidth As Double 
Dim clHeight As Double 

Dim BallSize As Long 
Dim FirstColumnKV As Long 
Dim FirstRowKV As Long 
Dim findcellKV As Variant 

Dim cl As Range 
Dim shpOval As Shape 
Dim Counter As Integer 

'set x equal to the id of your sheet 
Set ws = ThisWorkbook.Worksheets(x) 
BallSize = 8 
FirstColumnKV = 24 
FirstRowKV = 11 

For Counter = FirstRowKV To 20 
findcellKV = ws.Range(Counter, FirstColumnKV).Value 
Set cl = ws.Range(Counter, FirstColumnKV) 

clLeft = cl.Left 
clTop = cl.Top 
'I'm pretty sure that this wont work, but I cant test it, without your file. 
clOffsetV = (cl.Height/2) - (BallSize/2) 
clOffsetH = (cl.Width/2) - (BallSize/2) 

'Also not sure if this will work. 
Set shpOval = ActiveSheet.Shapes.AddShape(msoShapeOval, clLeft + clOffsetH,clTop + clOffsetV, BallSize, BallSize) 
shpOval.Fill.ForeColor.RGB = RGB(152, 52, 7) 
shpOval.Line.ForeColor.RGB = RGB(152, 52, 7) 
shpOval.Line.Weight = 1 

Next 

End Sub 

は、私の知る限り、これはあなたがループを通るすべてのセルに「ボール」を入れます。ある種のif -statementを挿入しなければなりません。

Answer 2

@Tomあなたの丁寧な対応に感謝します。しかし何らかの理由で、 "Counter、FirstColumnKV"として定義された範囲は機能していないようです。私がFirstColumnKVを "X"に設定し、 "FirstColumnKV & Counter"を使うと、うまくいきます。いずれにせよ、元の問題は今解決されています。問題は、If文の欠落と若干の並べ替えです。

Sub Bolletjes() 

Dim Wb As Workbook 
Dim Ws As Worksheet 

Const BallSize = 8 
Const FirstColumnKV = "X" 
Const FirstRowKV = 11 

Dim clLeft As Double 
Dim clTop As Double 
Dim clWidth As Double 
Dim clHeight As Double 

Dim findcellKV As Variant 

Dim cl As Range 
Dim shpOval As Shape 
Dim Counter As Integer 

Set Ws = ActiveWorkbook.Sheets("C_Portfolio") 

For Counter = FirstRowKV To 19 
findcellKV = Ws.Range(FirstColumnKV & Counter).Value 

If Format(Range(FirstColumnKV & Counter).Value) <> vbNullString Then 
Set cl = Range(findcellKV) 
clLeft = cl.Left 
clTop = cl.Top 
clOffsetV = cl.Height/2 - BallSize/2 
clOffsetH = cl.Width/2 - BallSize/2 

Set shpOval = ActiveSheet.Shapes.AddShape(msoShapeOval, clLeft + clOffsetH, clTop + clOffsetV, BallSize, BallSize) 
shpOval.Fill.ForeColor.RGB = RGB(152, 52, 7) 
shpOval.Line.ForeColor.RGB = RGB(152, 52, 7) 
shpOval.Line.Weight = 1 

End If 

Next 

End Sub