[英]Move Shape based on cell value
如第一张图片是里程碑工作表中的里程碑,第二张图片是计划工作表,其中条形上的三角形将与里程碑工作表中的参考日期 (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
不是一个解决方案,一个指针,而是想要这个必须提供的格式。
我必须做一些工作才能让match
function 工作,你可以使用.find
here 或类似的东西。 希望这可以帮助您或启发您。
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.