Question

我正在尝试为员工计算连续的休息日，并且在单元格中使用Shapes来显示他们的日程安排。我试图计算所选单元格左侧或右侧的单元格是否包含具有特定RGB的形状->那么它将算作连续一天的休假。在使用形状之前，我可以使用cell.offset(0,-1).interior.color=rgb(64,64,64)或cell.offset(0,1).interior.color进行检查，但是对于形状，我现在不知道如何引用这些单元格。

这是代码的一部分。

Sub Consecutive_count()
Dim TotalOff As Long
Dim myrange As Range
Dim cell As Range
Dim Numfound As Long
Dim i As Long
Dim Mycount As Long
Dim shpOval As Shape

Set myrange = ActiveSheet.Range("C6:I13")

'looping through shpOvals to count TotalOFF

For Each shpOval In ActiveSheet.Shapes
    If shpOval.AutoShapeType = msoShapeOval And shpOval.Fill.ForeColor.RGB = RGB(64, 64, 64) Then
        TotalOff = TotalOff + 1
    End If

'This part isn't working: Need to check if cells around the black shape also contain black shapes

    If shpOval.Fill.ForeColor.RGB = RGB(64, 64, 64) And (cell.Offset(0, 1).Interior.Color = RGB(64, 64, 64) Or cell.Offset(0, -1).Interior.Color = RGB(64, 64, 64)) Then
        Numfound = Numfound + 1

    End If
Next shpOval


If Numfound > 0 Then
    Range("AA9").Value = Format(Numfound / TotalOff, "#.##%")
Else: Range("AA9").Value = "0%"
End If

End Sub

Answer 1

您可以通过访问TopLeftCell方法来访问形状左上角所在的单元格。

因此，if语句中的第二个条件如下：

shpOval.TopLeftCell.Offset(0, 1).Interior.Color = RGB(64, 64, 64)

对于第三个条件，您需要能够从作为其左上角单元格的单元格中引用形状。为此，您可以使用类似这样的函数，该函数遍历所有形状并找到左上角第一个具有您提供的单元格的

Function TopLeftCellToShape(ByRef MyTopLeftCell As Range) As Shape

    Dim shp As Shape
    For Each shp In MyTopLeftCell.Parent.Shapes
        If shp.TopLeftCell.Address = MyTopLeftCell.Address Then
            Set TopLeftCellToShape = shp
            Exit Function
        End If
    Next

End Function

因此，您的第三个条件是：

TopLeftCellToShape(cell.Offset(0, -1)).Fill.ForeColor.RGB = RGB(64, 64, 64)

检查所选单元格左右两侧的单元格是否包含“形状”

1 个答案: