Excel 基于单元值移动形状

如第一幅图所示，是里程碑工作表中的里程碑，第二幅图是计划工作表中的里程碑，其中条形图上的三角形将与里程碑工作表中的参考日期（C5）一起移动。 这些里程碑应根据计划工作表中的值正确引用。 例如，里程碑工作表c5=6月14日，三角形应放置在单元格M12中横杆上方一行，即计划工作表中的6月14日。其他里程碑也必须如此

我是VBA新手，我尝试了一些东西，但没有运行。 我想我的手机范围选择错了。 代码如下：

Sub Check()
    Dim rng As Range
    Set rng = Sheets("Gleichschenkliges Dreieck 1").Range("H$10:cm$10")
    For Each cell In rng  
    If cell.Value <> "" Then
            Set rng = Range("C13").End(xlToRight).Offset(0, 1)
            ActiveSheet.Shapes("Gleichschenkliges Dreieck 1").Left = rng.Left
    End If
    Next
End Sub

子检查（）
变暗rng As范围
设置rng=板材（“Gleichschenkliges-Dreieck 1”）。范围（“H$10:cm$10”）
对于rng中的每个单元
如果单元格的.Value为“”，则
设置rng=范围（“C13”）。结束（xlToRight）。偏移（0，1）
ActiveSheet.Shapes（“Gleichschenkliges-Dreieck 1”）.Left=rng.Left
如果结束
下一个
端接头

---

不是一个解决方案，不是一个指针，而是想要它提供的格式

为了让

匹配

函数正常工作，我做了一些工作，您可以使用

。在这里查找
或类似的内容。希望这能帮助你或激励你

Sub test_ct()

Dim r As Excel.Range
Dim r2 As Excel.Range
Dim l As Long
Dim s As Shape
Dim d As Date

d = CDate("01/05/2019")

'   Range of my dates at the top
Set r = Sheets("Sheet10").Range("c1:o1")
'   The shape i want to move
Set s = Sheets("Sheet10").Shapes("Triangle1")

'   Set default position
s.Left = 10

'   Get the column of this date, MATCH intended here, but failing on dates.
l = Application.WorksheetFunction.Match(CDbl(CDate("01/05/2019")), r, 0)

'   Destination plus 1/2 width, needs fine tuning, to find centre
l = r(1, l).Left
l = l + (r(1, l).Width / 4)

'   Move the shape
s.Left = l


End Sub

谢谢它的工作，但我必须把小条件在那里，正如我上面提到的。当我从里程碑工作表（C5）更改日期时，形状应移动到计划工作表中月份（H10:CM10）的特定匹配。当前，当我从VBA窗口手动更改日期时，形状会移动，但我希望链接它们。谢谢希望你能理解我的怀疑。