VBA循环遍历范围以增加引用单元格的形状

我基本上想要做的是在Excel中build立一个甘特图：每列代表一个星期。 现在，我想添加里程碑，我希望通过在一周中间添加一个小点（形状）来实现里程碑。 在我的数据中，我有一列（X），指定在哪个单元格中放置一个形状; 这是不同的每一行。 截图应该澄清我的意思。 我可以做一行，但我有build设循环，从单元格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 keyword）。 所以为了你的目的，你应该把它们定义为variables，最好是Long 。

其次，IMO在VBA代码中使用索引字母不是很stream畅。 尝试使用索引号来引用单元格或列。 你可以添加，繁殖和做很多其他有趣的东西，你不能用索引字母。

至于你的代码：

 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＆计数器”它确实工作正常。 无论如何，原来的问题现在已经解决了。 问题是缺less的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