Question

以下代码取自Similar values in range make it as a KEY and sum function链接，但是，我对其进行了小幅调整（添加了更多要检查的单元格）。代码的作用是检查第4,5,8,36和37列是否在其单元格中具有相似的值/文本。如果是，那么它在第59栏中查找并使用总和函数来检查相似条目的值是更少还是更高而不是 100 。如果是，则第59列中的单元格变为红色，否则，它们应保持白色。

示例：

第4列：细胞D5，D6和D7 - 均为P11
第5列：单元格E5，E6和E7 - 均为P12
第8列：细胞H5，H6和H7 - 均为P13
第36列：细胞AJ5，AJ6和AJ7 - 均为P14
第37列：细胞AK5，AK6和AK7 - 都是P15
第59列：电池BG5 = 40且BG6 = 20且BG7 = 30.总值：90，其不等于100.此后，BG5，BG6和BG7必须变为红色。（sum函数仅在提到的其他列在其行中具有相似值时才起作用）

代码只检查第4,5和8列时没有收到任何错误。但是，在我添加了第36和37列后，收到以下错误：无法获取范围类的内部属性 - 运行时错误1004 ，我不知道如何解决这个问题。

注意：第4,5,8,36,37和59列也有条件格式公式 isblank ，如果它们为空，则将单元格变为红色。原因是人们需要知道必须完成这些细胞。

感谢您的帮助和时间！

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim i As Long, j As Long, sum1 As Long, k As Long, c(5000) As Long
    Application.EnableEvents = False
    Range("bg5:bg5000").Interior.Color = RGB(255, 255, 255)
    For i = 5 To 4999
        k = 0
        For j = i + 1 To 5000
           If Cells.Interior.Color <> RGB(255, 0, 0) Then
                If Cells(i, 4) & Cells(i, 5) & Cells(i, 8) & Cells(i, 36) & Cells(i, 37) <> "" Then
                    If Cells(i, 4) = Cells(j, 4) And Cells(i, 5) = Cells(j, 5) And Cells(i, 8) = Cells(j, 8) And Cells(i, 36) = Cells(j, 36) And Cells(i, 37) = Cells(j, 37) Then
                        If k = 0 Then sum1 = Cells(i, 59): k = 1: c(k) = i
                        sum1 = sum1 + Cells(j, 59)
                        k = k + 1
                        c(k) = j
                    End If
                End If
            End If
        Next j
        If sum1 <> 100 Then
            For j = 1 To k
                Cells(c(j), 59).Interior.Color = RGB(255, 0, 0)
            Next j
        End If
    Next i
    Application.EnableEvents = True
End Sub

Answer 1

这里是一个改编代码的提案。请注意，每次在第59列中输入值时，宏都会运行，并且它会在循环中执行代码大约250000次，这可能需要一些时间。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, j As Long, sum1 As Long, k As Long, c(5000) As Long
    If Target.Column <> 59 Then Exit Sub
    Application.EnableEvents = False
    Range("bg5:bg5000").Interior.Color = RGB(255, 255, 255)
    For i = 5 To 4999
        k = 0
        If Cells(i, 4) & Cells(i, 5) & Cells(i, 8) & Cells(i, 36) & Cells(i, 37) <> "" Then
            If Cells(i, 59).Interior.Color <> RGB(255, 0, 0) Then
                For j = i + 1 To 5000
                    If Cells(j, 59).Interior.Color <> RGB(255, 0, 0) Then
                        If Cells(j, 4) & Cells(j, 5) & Cells(j, 8) & Cells(j, 36) & Cells(j, 37) <> "" Then
                            If Cells(i, 4) = Cells(j, 4) And Cells(i, 5) = Cells(j, 5) And Cells(i, 8) = Cells(j, 8) And Cells(i, 36) = Cells(j, 36) And Cells(i, 37) = Cells(j, 37) Then
                                If k = 0 Then sum1 = Cells(i, 59): k = 1: c(k) = i
                                sum1 = sum1 + Cells(j, 59)
                                k = k + 1
                                c(k) = j
                            End If
                        End If
                    End If
                Next j
                If sum1 <> 100 Then
                    For j = 1 To k
                        Cells(c(j), 59).Interior.Color = RGB(255, 0, 0)
                    Next j
                End If
            End If
        End If
    Next i
    Application.EnableEvents = True
End Sub

代码改编，如果你想将它链接到一个按钮，添加一个按钮，右键单击按钮并将此宏（aargh）分配给它。

Sub aargh()
    Dim i As Long, j As Long, sum1 As Long, k As Long, c(5000) As Long, fl(5000) As Boolean
    Dim s1 As String, s2 As String
    Range("bg5:bg5000").Interior.Color = RGB(255, 255, 255)
    For i = 5 To 4999
        k = 0
        s1 = Cells(i, 4) & Cells(i, 5) & Cells(i, 8) & Cells(i, 36) & Cells(i, 37)
        If s1 <> "" Then
            If Not fl(i) Then
                For j = i + 1 To 5000
                    If Not fl(j) Then
                        s2 = Cells(j, 4) & Cells(j, 5) & Cells(j, 8) & Cells(j, 36) & Cells(j, 37)
                        If s2 <> "" Then
                            If s1 = s2 Then
                                If k = 0 Then sum1 = Cells(i, 59): k = 1: c(k) = i: fl(i) = True
                                sum1 = sum1 + Cells(j, 59)
                                k = k + 1
                                c(k) = j
                                fl(j) = True
                            End If
                        End If
                    End If
                Next j
                If sum1 <> 100 Then
                    For j = 1 To k
                        Cells(c(j), 59).Interior.Color = RGB(255, 0, 0)
                    Next j
                End If
            End If
        End If
    Next i
End Sub

无法获取范围类的内部属性 - 运行时错误1004

1 个答案: