3

我正在使用 VBA 代码放置条件格式以覆盖大表中的值，每个单元格使用 2 个公式来确定要使用的 3 个符号中的哪一个。我需要根据列用不同的单元格检查每个单元格的值，因此据我所知，我必须将条件格式规则分别放在每个单元格上，以确保每个单元格中的公式正确。这是因为条件格式不能采用相对地址，你必须给它每个单元格的确切地址......对吗？

大量的条件格式实例在很大程度上降低了我的计算机速度。

是否可以在不使用条件格式的情况下将条件格式使用的符号放入单元格中？

可能有点像图像，但同时保留下面的单元格值，可以使用条件格式来完成。

下面我给出了用于放置条件格式的代码。很感谢任何形式的帮助！！

    Dim AIs As Range
    Dim rng As Range
    Dim cl As Range

    Set AIs = ActiveSheet.Range("Table")
    For Each cl In AIs.Columns
        For Each rng In cl.Cells

        rng.FormatConditions.AddIconSetCondition
        rng.FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With rng.FormatConditions(1)
            .ReverseOrder = False
            .ShowIconOnly = True
            .IconSet = ActiveWorkbook.IconSets(xl3Symbols2)
        End With

         With rng.FormatConditions(1).IconCriteria(1)
            .Icon = xlIconYellowExclamationSymbol
        End With
        With rng.FormatConditions(1).IconCriteria(2)
            .Icon = xlIconRedCross

            .Type = xlConditionValueFormula
            .Value = "=IF(VALUE(LEFT(" & rng.Parent.Cells(5, rng.Column).Address & _
                  ";1)=0;1;6)"

            .Operator = 7
        End With
        With rng.FormatConditions(1).IconCriteria(3)
            .Icon = xlIconGreenCheck

            .Type = xlConditionValueFormula
            .Value = "=IF(VALUE(LEFT(" & rng.Address & ";1))<=VALUE(LEFT(" & _
                  rng.Parent.Cells(5, rng.Column).Address & ";1));1;6)"

            .Operator = 7
        End With
        Next rng
    Next cl
4

2 回答 2

1

将形状直接添加到单元格：

Dim cLeft As Single
Dim cTop As Single

cLeft = rng.Left
cTop = rng.Top

with AIs.Shapes.AddShape(msoShapeOval, cLeft, cTop, 12, 12)
    .ForeColor.RGB = RGB(255, 0, 0)
    'Other properties can be found at
    'http://msdn.microsoft.com/en-us/library/office/bb251480%28v=office.12%29.aspx
end with

您可能需要调整 cTop 和 cLeft，以及宽度/高度以根据需要定位圆

于 2013-08-14T13:31:55.713 回答
0

最终代码：

     Set AIs = ActiveSheet.Range("Table")
     For Each cl In AIs.Columns
        For Each rng In cl.Cells

            'Shapes  - GRADE MASK


            cLeft = rng.Left + 5 - (rng.ColumnWidth / 2)
            cTop = rng.Top + (rng.RowHeight / 2 - 5)

            If Not rng = "" And rng.ColumnWidth = 3 And rng.RowHeight > 12 Then

            If rng.Parent.Cells(5, rng.Column) = 0 Then
                With wks.Shapes.AddShape(msoShapeOval, cLeft, cTop, 10, 10)
                    .Fill.ForeColor.RGB = RGB(255, 0, 0)
                End With
            End If
            If CInt(Left(rng, 1)) >= CInt(Left(rng.Parent.Cells(5, rng.Column), 1)) And _
             Not rng.Parent.Cells(5, rng.Column) = 0 Then
                With wks.Shapes.AddShape(msoShapeOval, cLeft, cTop, 10, 10)
                    .Fill.ForeColor.RGB = RGB(0, 255, 0)
                End With
            End If
            If CInt(Left(rng, 1)) < CInt(Left(rng.Parent.Cells(5, rng.Column), 1)) Then
                With wks.Shapes.AddShape(msoShapeOval, cLeft, cTop, 10, 10)
                    .Fill.ForeColor.RGB = RGB(255, 204, 0)
                End With
            End If
            End If
        Next rng
    Next cl

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
       userinterfaceonly:=True

然后每次我调用一个宏时，我都会删除工作表上的所有形状，执行我的宏，然后再次调用它，在上面的 if 语句中检查列宽和行高有多大，一个形状只有如果单元格“可见”则插入

在我的程序中，由于此子程序之外的其他原因，我无法隐藏我的行或列，而是将它们的高度或宽度减小到足以显示单元格边框的大小。

于 2013-08-15T14:53:35.190 回答