Question

我已经格式化了一个工作表，允许我：

双击空白单元格，背景颜色变为红色，并为其指定值为＃34; Not Recvd＆＃34;。
再次双击它，然后用＆＃34; Partial＆＃34;值。
再次双击它，然后用＆＃34; Recvd＆＃34;值。
再次双击它，使用＆＃34; NA＆＃34;值。
再次双击它，它会变回空白。

我能够在教程和在线搜索的帮助下完成这项工作。我想在电子表格中添加更多功能，但我们无法找到/计算出这些功能。需要插入现有代码的功能包括：

指定特定单元格/范围（与工作表上的每个单元格相对），如上所述通过双击更改颜色/值的功能。我需要指定120个单元格。
假设没有一个单元格是空白的，我需要插入一个方程式来计算120个非蓝色单元格的百分比/＆＃34; NA＆＃34;是红色的＆＃34; Not Recvd＆＃34 ;;是橙色/＆＃34;部分＆＃34 ;;并且是绿色/＆＃34; Recvd＆＃34;。这些百分比将位于同一工作表上，我想知道如何指定特定的单元格/范围。

我希望它看起来像这样：

Not Recvd  15%
Partial    20%
Recvd      65%

这是我到目前为止的现有代码：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)

    If Target.Interior.ColorIndex = xlNone Then
        Target.Value = " "
        Target.Interior.ColorIndex = 3
        Target.Value = "Not Recvd"
    ElseIf Target.Interior.ColorIndex = 3 Then
        Target.Interior.ColorIndex = 45
        Target.Value = "Partial"
    ElseIf Target.Interior.ColorIndex = 45 Then
        Target.Interior.ColorIndex = 4
        Target.Value = "Recvd"
    ElseIf Target.Interior.ColorIndex = 4 Then
        Target.Interior.ColorIndex = 41
        Target.Value = "N/A"
    ElseIf Target.Interior.ColorIndex = 41 Then
        Target.Interior.ColorIndex = xlNone
        Target.Value = " "
    End If

    Cancel = True
End Sub

我使用的是Windows XP和Excel 2003。

Answer 1

我必须修复你的单元格区域中的一些拼写错误，但我确定了它的重复模式并将其分成两个引用行和列的字符串。我把它放在声明区域（工作表代码表的顶部）作为私有常量字符串。

Private Const pcISECcols As String = "H:H,K:K,N:N,Q:Q,T:T,W:W"
Private Const pcISECrows As String = "6:7,10:12,15:17,20:24,27:27,30:30,33:33,36:36,39:39,42:42,45:45,48:48,51:51,54:54,57:57"

这些将用于定义Intersect（Intersect method）调用中的范围对象，以查看是否应包含双击的单元格。当我跑Intersect(Range(pcISECcols), Range(pcISECrows)).Interior.ColorIndex = 10时，我想出了这个。

Intersect(target, rows, columns)

虽然这实际上是144个单元而不是120个单元，但我最好的猜测是你所提供的所有需要做的就是添加你双击相交函数的单元格来实现直流滤波响应。

虽然我发现您对'百分比的描述位于AA22，AA23，AA24'的描述有些含糊不清，但我认为这些百分比的目标是AA22：AA24和标识每个百分比的图例描述适用于Z22：Z24。

Option Explicit

Private Const pcISECcols As String = "H:H,K:K,N:N,Q:Q,T:T,W:W"
Private Const pcISECrows As String = "6:7,10:12,15:17,20:24,27:27,30:30,33:33,36:36,39:39,42:42,45:45,48:48,51:51,54:54,57:57"

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range(pcISECcols), Range(pcISECrows)) Is Nothing Then
        On Error GoTo Fìn
        Cancel = True
        Application.EnableEvents = False
        Dim iCNT As Long, rPCT As Range
        'Debug.Print Intersect(Range(pcISECcols), Range(pcISECrows)).Count
        'Debug.Print Intersect(Range(pcISECcols), Range(pcISECrows)).Address
        Select Case Target.Interior.ColorIndex
            Case xlNone
                Target.Interior.ColorIndex = 3
                Target.Value = "Not Recvd"
            Case 3
                Target.Interior.ColorIndex = 45
                Target.Value = "Partial"
            Case 45
                Target.Interior.ColorIndex = 4
                Target.Value = "Recvd"
            Case 4
                Target.Interior.ColorIndex = 41
                Target.Value = "N/A"
            Case 41
                Target.Interior.ColorIndex = xlNone
                Target.Value = vbNullString
            Case Else
                Target.Interior.Pattern = xlNone
                Target.Value = vbNullString
        End Select

        Range("AA22:AA24") = 0
        With Intersect(Range(pcISECcols), Range(pcISECrows))
            iCNT = .Count
            Debug.Print iCNT
            For Each rPCT In .Cells
                Select Case rPCT.Interior.ColorIndex
                    Case 3
                        Range("AA22") = Range("AA22").Value2 + 1
                    Case 45
                        Range("AA23") = Range("AA23").Value2 + 1
                    Case 4
                        Range("AA24") = Range("AA24").Value2 + 1
                    Case 41
                        iCNT = iCNT - 1
                    Case Else
                        'do nothing
                End Select
            Next rPCT
            Debug.Print iCNT
            Range("AA22") = Range("AA22").Value2 / iCNT
            Range("AA23") = Range("AA23").Value2 / iCNT
            Range("AA24") = Range("AA24").Value2 / iCNT
        End With
    End If
Fìn:
    Application.EnableEvents = True
End Sub

这应该是全部。对于每个蓝色单元格，非连续范围内的单元格的计数递减，并且使用该计数而不是所有单元格检索百分比。

如果您希望将实际工作表函数用于更宽的百分比，您实际上可以在整个非连续范围内使用创建COUNTIF公式。使用COUNTIF的不连续范围很困难，但并非不可能。 AA2的公式为

    =SUM(COUNTIF(INDIRECT({"H6:H7","H10:H12","H15:H17","H20:H24","H27","H30","H33","H36","H39","H42","H45","H48","H51","H54","H57","K6:K7","K10:K12","K15:K17","K20:K24","K27","K30","K33","K36","K39","K42","K45","K48","K51","K54","K57","Q6:Q7","Q10:Q12","Q15:Q17","Q20:Q24","Q27","Q30","Q33","Q36","Q39","Q42","Q45","Q48","Q51","Q54","Q57","N6:N7","N10:N12","N15:N17","N20:N24","N27","N30","N33","N36","N39","N42","N45","N48","N51","N54","N57","T6:T7","T10:T12","T15:T17","T20:T24","T27","T30","T33","T36","T39","T42","T45","T48","T51","T54","T57","W6:W7","W10:W12","W15:W17","W20:W24","W27","W30","W33","W36","W39","W42","W45","W48","W51","W54","W57"}), Z22))/144

格式化为百分比并填写为AA24。

将目标限制为一系列不连续的单元格

1 个答案: