Question

大家欢呼！表达下面的代码对我来说有点复杂，但我会试一试。下面的代码应该做以下事情：

1.检查列 D，E，H 和 M 的范围。色谱柱 D，E 和 H 在其范围内具有相似的值，即： D5 = V 且 D6 = V ; E5 = B 且 E6 = B ; H5 = A 且 H6 = A ，而列 M 的数字为数字，即 M5 = 40 且 M6 = 70 。

2.Column M（意味着范围（m5：m50）必须总结M5和M6的值：40 + 70.它总结的原因是因为范围（ D5：D6，E5：E6， H5：H6 ）在列中具有相似的值。只有这样，当所有其他列提到时，sumfunction必须在范围（“m5：m50”）中启动（ D， E和H ）在它们的范围内具有相似的值。将其作为键（ D5＆amp; E5＆amp; H5 = VBA; D6＆amp; E6＆amp; H6 = VBA ）。两者都相似。然后，如果

3.范围（“m5：m50”）中的2个值是＆gt; 100 ，两个细胞（ M5 和 M6 变红）。否则，不采取任何行动。

Private Sub Worksheet_Change(ByVal Target As Range)

        Dim cell As Range

            Application.EnableEvents = False

        For Each cell In Target

                            If (cell.Range("d5:d50").Value) & (cell.Range("e5:e50").Value) & (cell.Range("h5:h50").Value) Then
                                Sum1 = Application.WorksheetFunction.Sum(cell.Range("m5:m50"))

                                If Sum1 > 100 Then

                                   cell.Range("m5:m50").Interior.Color = RGB(255, 0, 0)

                    Else
                                   cell.Range("m5:m50").Interior.Color = RGB(255, 255, 255)

                            End If
                            End If
                   Next

            Application.EnableEvents = True

        End Sub

我的代码似乎不起作用，但我也没有任何错误。我真的很感激，如果有人可以帮助我解决我的问题，因为我没有想法。提前谢谢！

Answer 1

如果我的理解是正确的，我建议改编你的代码

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, j As Long, sum1 As Long, k As Long, c(50) As Long
    Application.EnableEvents = False
    For i = 5 To 49
        sum1 = 0
        k = 0
        For j = i + 1 To 50
            If Cells(i, 4) = Cells(j, 4) And Cells(i, 5) = Cells(j, 5) And Cells(i, 8) = Cells(j, 8) Then
                If sum1 = 0 Then sum1 = Cells(i, 13): k = 1: c(k) = i: Cells(i, 13).Interior.Color = RGB(255, 255, 255)
                sum1 = sum1 + Cells(j, 13)
                k = k + 1
                c(k) = j
                Cells(j, 13).Interior.Color = RGB(255, 255, 255)
            End If
        Next j
        If sum1 > 100 Then
            For j = 1 To k
                Cells(c(j), 13).Interior.Color = RGB(255, 0, 0)
            Next j
        End If
    Next i
    Application.EnableEvents = True
End Sub

更强大的代码版本

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, j As Long, sum1 As Long, k As Long, c(50) As Long
    Application.EnableEvents = False
    Range("M5:M50").Interior.Color = RGB(255, 255, 255)
    For i = 5 To 49
        k = 0
        For j = i + 1 To 50
            If Cells.Interior.Color <> RGB(255, 0, 0) Then
                If Cells(i, 4) & Cells(i, 5) & Cells(i, 8) <> "" Then
                    If Cells(i, 4) = Cells(j, 4) And Cells(i, 5) = Cells(j, 5) And Cells(i, 8) = Cells(j, 8) Then
                        If k = 0 Then sum1 = Cells(i, 13): k = 1: c(k) = i
                        sum1 = sum1 + Cells(j, 13)
                        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), 13).Interior.Color = RGB(255, 0, 0)
            Next j
        End If
    Next i
    Application.EnableEvents = True
End Sub

Answer 2

请尝试此代码。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 18 Jan 2018

    Const FirstRow As Long = 5                  ' adjust as required
    Const LastRow As Long = 50                  ' adjust as required

    Dim Rng As Range                            ' M5:M50
    Dim Test1 As String                         ' concatenate values D:H
    Dim Test2 As Boolean                        ' Sum(M5:M50) > 100
    Dim Arr As Variant
    Dim R As Long

    With Target
        ' columns D, E, H, M
        If IsError(Application.Match(.Column, Array(4, 5, 8, 13), 0)) Then Exit Sub
        If .Row < FirstRow Or .Row > LastRow Then Exit Sub
    End With

    Arr = Range(Cells(FirstRow, "D"), Cells(LastRow, "H")).Value
    R = LBound(Arr)
    Test1 = Arr(R, 1) & Arr(R, 2) & Arr(R, 5)    ' columns D, E and H

    For R = (R + 1) To UBound(Arr)
        If StrComp(Test1, (Arr(R, 1) & Arr(R, 2) & Arr(R, 5)), vbTextCompare) Then Exit For
    Next R

    If R > UBound(Arr) Then
        Set Rng = Range(Cells(FirstRow, "M"), Cells(LastRow, "M"))
        Test2 = (Application.Sum(Rng) > 100)
    End If

    ' Setting range to colour red: adjust as required
    Set Rng = Range(Cells(FirstRow, "M"), Cells(FirstRow + 1, "M"))
    Rng.Interior.Color = IIf(Test2, 255, xlNone)
End Sub

我发现您的代码与您的任务描述明显不同，关于哪些单元格为红色。我的代码遵循您的描述（或我如何理解），只有颜色M5：M6。但是，一旦你了解它的工作原理，我认为你可以很容易地调整代码的这个细节，或者它的任何其他部分。祝你好运！

Answer 3

您似乎正在编写自己的条件格式。我不知道为什么你这样做，而不是使用条件格式，但如果你坚持重新发明轮子..我相信以下将做你想要的。

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim cell As Range
    Dim thisrowtext As String, nextrowtext As String

    Application.EnableEvents = False

    For Each cell In Me.Range("m5:m50")

        thisrowtext = cell.Offset(0, -9).Text & cell.Offset(0, -8).Text & cell.Offset(0, -5).Text
        nextrowtext = cell.Offset(1, -9).Text & cell.Offset(1, -8).Text & cell.Offset(1, -5).Text

        If thisrowtext = nextrowtext And cell.Value > 100 Then
                cell.Interior.Color = RGB(255, 0, 0)
        Else
                cell.Interior.Color = RGB(255, 255, 255)
        End If
    Next

    Application.EnableEvents = True

End Sub

范围内的类似值使其成为KEY和sum函数

3 个答案: