Question

下面写的VBA代码是由stackoverflow中的用户完成的，但不幸的是我找不到链接到那个。

代码检查第2,4,6,8,10和11列，看它们是否在单元格中输入了相似的值。例如，如果第2,4,6,8,10和11列中的第4行和第5行都插入了相似的值，则会检查第15列以查看第4行和第5行中的值是否等于20（可以输入的最大值））。如果没有，则会出现错误。否则，一切都很好。

其次，我要添加的是，当第4行和第5行中的值不相等时，第15行中的数字对于第4行和第5行都需要为20.我在下面设置了一个示例如何输入可能会在Excel中查找。

总的来说，如果上述列中的值不相似，则列15中插入的数字总是必须为20。否则，当列插入类似的值时，它们的总和需要等于20.感谢您帮忙！

很好的例子：这就是代码现在所做的。

    2       4     6      8      10       11      15 

4   home    US    dog    car    plate    food    16   
5   home    US    dog    car    plate    food    3
20  home    US    dog    car    plate    food    1

这就是我现在想要实现的代码：

    2       4     6      8      10       11          15 

4   home    US    dog    car    plate    food        20   
5   home    US    dog    car    plate    tv          20
20  home    US    dog    car    plate    kitchen20   20

此处每行不同，此后，每行需要在第15列中具有值20.

Private Sub CommandButton1_Click()

Dim iz As Long, jz As Long, sum1 As Long, kz As Long, c(1000) As Long, fl(1000) As Boolean, b As Boolean, sum2 As Long

Application.ScreenUpdating = False


    Dim s1 As String, s2 As String
    Range("a4:a1000").Interior.Color = RGB(255, 255, 255)
    For iz = 4 To 999
        kz = 0
        s1 = Cells(iz, 2) & Cells(iz, 4) & Cells(iz, 6) & Cells(iz, 10) & Cells(iz, 11)
        If s1 <> "" Then
            If Not fl(iz) Then
                For jz = iz + 1 To 1000
                    If Not fl(jz) Then
                        s2 = Cells(jz, 2) & Cells(jz, 4) & Cells(jz, 6) & Cells(jz, 10) & Cells(jz, 11)
                        If s2 <> "" Then
                            If s1 = s2 Then
                                If kz = 0 Then sum1 = Cells(iz, 15): kz = 1: c(kz) = iz: fl(iz) = True
                                sum2 = sum1 + Cells(jz, 15)
                                kz = kz + 1
                                c(kz) = jz
                                fl(jz) = True
                            End If
                        End If
                    End If
                Next jz
                If sum2 <> 20 Then
                    For jz = 1 To kz
                        Cells(c(jz), 15).Interior.Color = RGB(255, 0, 0)
                        b = True
                    Next jz

                ElseIf sum2 = 20 Then
                        For jz = 1 To kz
                    Cells(c(jz), 40).Value = 1
                    Next jz


                End If
            End If
        End If


    Next iz



If b Then MsgBox "The values don't equal 20%." & Chr(10) & _
                        "Make the changes an try again!", vbInformation, "IMPORTANT:" Else MsgBox "No errors found!", vbInformation, "IMPORTANT:"



Application.ScreenUpdating = True


End Sub

Answer 1

尝试以下代码。

要运行此代码，您需要进入VBE 工具 - ＆gt;引用... 并检查 Microsoft Scripting Runtime 。

使用Dictionary，整个任务变得简单，并且不需要您提供的复杂代码。它将所有单元格（第15列除外）视为关键。每个键获得第一个循环中第15列的所有相应值。在第二个循环中，检查对应于该键的值是否等于20，如果不是，则将该行着色为红色（或在该情况下进行其他操作）。

我解释的功能是分组的想法，因此宏的名称：）

Option Explicit
Sub GroupBy()

    Dim lastRow As Long, i As Long, dict As Scripting.Dictionary, key As String
    lastRow = Cells(Rows.Count, 2).End(xlUp).Row
    Set dict = New Scripting.Dictionary

    For i = 1 To lastRow
        key = Cells(i, 2) & Cells(i, 4) & Cells(i, 6) & Cells(i, 8) & Cells(i, 10) & Cells(i, 11)

        If dict.Exists(key) Then
            dict(key) = dict(key) + Cells(i, 15)
        Else
            dict.Add key, CInt(Cells(i, 15))
        End If
    Next

    For i = 1 To lastRow
        key = Cells(i, 2) & Cells(i, 4) & Cells(i, 6) & Cells(i, 8) & Cells(i, 10) & Cells(i, 11)
        'if value is other than 20, color the row with red
        If dict(key) <> 20 Then Cells(i, 15).Interior.ColorIndex = 3
    Next

End Sub

VBA循环检查不同列

1 个答案: