时间戳

首页 > 解决方案 > 检查所选单元格左侧和右侧的单元格是否包含形状

excel - 检查所选单元格左侧和右侧的单元格是否包含形状

问题描述

我正在尝试计算员工的连续休假天数，并且我在单元格中使用 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

标签： excelvba

解决方案

您可以通过访问方法访问形状左上角所在的单元格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)

推荐阅读