比较Excel中不同区域内的单元格

时间:2015-06-19 09:49:23

标签: excel vba excel-vba

我的要求的详细说明:

如果您想象一个Excel工作表,现在假设数据包含在两个单独的"组中。在工作表上。

让我们说第一个' group1'被定义为以下单元格中的数据:

                             [D4, E4, F4,
                              D5, E5, F5,
                              D6, E6, F6]

第二个"组",' group2',被定义为另一组包含数据的单元格:

                             [H4, I4, J4,
                              H5, I5, J5,
                              H6, I6, J6]

我想循环选定区域并按如下方式进行比较;

                             Compare D4 with H4,
                             Compare E4 with I4,
                             Compare F4 with J4,
                             Compare D5 with H5,
                             Compare E5 with I5,
                             Compare .....
                             Compare F6 with J6
                             End

当对每次迭代进行比较时,如果单元格元素相等,那么我希望单元格的背景颜色为白色,如果单元格元素不相等,我希望单元格的背景颜色保持不变< / p>

非常感谢任何建议。

在此处查看我的代码

Private Sub CommandButton1_Click()

Dim rangeToUse As Range, cell1 As Range, cell2 As Range, i As Integer, 
j As Integer

Set rangeToUse = Selection

If Selection.Areas.Count <= 1 Then
   MsgBox "Please select more than one area for cell to cell comparsion."
Else
    rangeToUse.Interior.ColorIndex = 39
     For i = 1 To rangeToUse.Areas.Count
      For j = i To rangeToUse.Areas.Count
          If cell1.Cells(i, j).Value = cell2.Cells(i, j).Value Then
                  cell1.Interior.ColorIndex = 0
                  cell2.Interior.ColorIndex = 0
          End If
  Next j
Next i

End If

End Sub

3 个答案:

答案 0 :(得分:0)

你没有发表任何问题,所以我会做两次猜测。

猜猜#1 : 您有许多Area个,大小不同,并且您希望避免格式化内容在Area之间的任何位置重复的单元格。

您需要两对嵌套循环,而不是一对。一对遍历Area。另一对在Cell s内遍历Area。 查找以下简化的代码。

Private Sub CommandButton1_Click()

    Dim rangeToUse As Range, cell1 As Range, cell2 As Range, i As Integer, j As Integer
    Dim area1 As Range, area2 As Range
    Dim n As Integer

    Set rangeToUse = Selection
    n = rangeToUse.Areas.Count

    If (n <= 1) Then
        MsgBox "Please select more than one area for cell to cell comparison."
    Else
        rangeToUse.Interior.ColorIndex = 39
        For i = 1 To n
            Set area1 = rangeToUse.Areas(i)
            For j = (i+1) To n
                Set area2 = rangeToUse.Areas(j)
                For Each cell1 In area1.Cells
                    For Each cell2 In area2.Cells
                        If (cell1.Value = cell2.Value) Then
                            cell1.Interior.ColorIndex = 0
                            cell2.Interior.ColorIndex = 0
                        End If
                    Next cell2
                Next cell1
            Next j
        Next i
    End If

End Sub

猜猜#2 : 您有两个Area,大小相同,并且您希望避免在相同位置格式化内容重复的单元格。

你需要一个循环。 查找以下简化的代码。

Private Sub CommandButton1_Click()

    Dim rangeToUse As Range, cell1 As Range, cell2 As Range, i As Integer, j As Integer
    Dim area1 As Range, area2 As Range
    Dim nr As Integer, nc As Integer

    Set rangeToUse = Selection
    n = rangeToUse.Areas.Count

    If (n <= 1) Then
        MsgBox "Please select more than one area for cell to cell comparison."
    Else
        rangeToUse.Interior.ColorIndex = 39
        Set area1 = rangeToUse.Areas(1)
        Set area2 = rangeToUse.Areas(2)
        nr = area1.Rows.Count
        nc = area1.Columns.Count
        For i = 1 To nr
            For j = 1 To nc
                Set cell1 = area1.Cells(i,j)
                Set cell2 = area2.Cells(i,j)
                If (cell1.Value = cell2.Value) Then
                    cell1.Interior.ColorIndex = 0
                    cell2.Interior.ColorIndex = 0
                End If
            Next j
        Next i
    End If

End Sub

PS:我没有系统来测试它。你可能需要对它进行微调。

PS2:代码可能在速度方面进行了优化,但是如果你没有看到任何性能问题,你就可以了。

答案 1 :(得分:0)

好的,所以我在这里(见下面的代码):

从运行调试器我已经确定我需要根除的问题存在于第20行和第29行之间。

使用sancho.s友好提供的原始代码(见上文)我将'area1'中的单元格与'area2'中的所有单元格进行比较,这不够好,因为循环通过'area2'进行了它可以找到多个比较并更改多个单元格中的ColorIndex,我不希望这样。

我只是想比较相应单元格中的值(假设方形选择)。

为了抵消这种情况,我在第25行包含了“退出”,但这导致原始问题的反转,因为第28行的“Cell2”没有增加。

基本上我需要一种方法让'Cell2'映射'Cell1'的位置/位置以启用类似比较

1.)Private Sub CommandButton1_Click()
2.)
3.)Dim rangeToUse As Range, cell1 As Range, cell2 As Range, i As Integer, 
4.)j As Integer
5.)Dim area1 As Range, area2 As Range
6.)Dim n As Integer
7.)
8.)Set rangeToUse = Selection
9.)n = rangeToUse.Areas.Count
10.)
11.)If (n <= 1) Then
12.)    MsgBox "Please select more than one area for cell to 
13.)            cell comparison."
14.) Else
15.)    rangeToUse.Interior.ColorIndex = 39
16.)For i = 1 To n
17.)        Set area1 = rangeToUse.Areas(i)
18.)        For j = (i + 1) To n
19.)           Set area2 = rangeToUse.Areas(j)
20.)            For Each cell1 In area1.Cells
21.)                For Each cell2 In area2.Cells
22.)                    If (cell1.Value = cell2.Value) Then
23.)                        cell1.Interior.ColorIndex = 0
24.)                        cell2.Interior.ColorIndex = 0
25.)                        Exit For
26.)                    End If
27.)                    
28.)                Next cell2
29.)            Next cell1
30.)        Next j
31.)    Next i
32.)End If

33.)End Sub

答案 2 :(得分:0)

这是完成的代码。它工作得非常好,所以我希望能节省一些时间。

Private Sub CommandButton1_Click()

Dim rangeToUse As Range, cell1 As Range
Dim area() As Range
Dim n As Integer
Dim same As Boolean

Set rangeToUse = Selection
n = rangeToUse.Areas.Count

If (n <= 1) Then
    MsgBox "Please select more than one area for cell to cell comparison."
Else
    ReDim area(1 To n)
    rangeToUse.Interior.ColorIndex = 39
    For i = 1 To n
        Set area(i) = rangeToUse.Areas(i)
    Next i
    For j = 1 To area(1).Cells.Count
    same = True
    For i = 2 To UBound(area)
    If area(i).Cells(j).Value <> area(i - 1).Cells(j).Value Then same=False
    Next i
    If same = True Then
        For i = 1 To UBound(area)
            area(i).Cells(j).Interior.ColorIndex = 2
        Next i
    End If
Next j
End If

End Sub