VBA多列数据对比不同？

Question

B 和 F 列对比，C和H, D 和G 对比，如果这三个对比的结果都是一致的，则所在列删除，并把差异标红就像图中结果一样。请问这个代码要怎么编写?谢谢。

Answer 1

简单写了一段 VBA 代码，供你参考和调试：

Option Explicit

Sub test()

Dim LastRow As Long

Dim TempRow As Long

Dim Pointer As Integer

With ActiveSheet

LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row                              '先获得 A 列最后一行的行号

For TempRow = LastRow To 2 Step 1

Pointer = 0                                                             '指针初始化

If Trim(.Cells(TempRow, 2)) <> Trim(.Cells(TempRow, 6)) Then            '如果 B 列与 F 列单元格的值不同

.Range("B" & TempRow & ",F" & TempRow).Interior.Color = 255         '把对应的单元格标识成红色

Else

Pointer = Pointer + 1                                               '否则指针加 1

End If

If Trim(.Cells(TempRow, 3)) <> Trim(.Cells(TempRow, 8)) Then            '如果 C 列与 H 列单元格的值不同

.Range("C" & TempRow & ",H" & TempRow).Interior.Color = 5287936     '把对应的单元格标识成绿色

Else

Pointer = Pointer + 1                                               '否则指针加 1

End If

If Trim(.Cells(TempRow, 4)) <> Trim(.Cells(TempRow, 7)) Then            '如果 D 列与 G 列单元格的值不同

.Range("B" & TempRow & ",F" & TempRow).Interior.Color = 49407       '把对应的单元格标识成橙色

Else

Pointer = Pointer + 1                                               '否则指针加 1

End If

If Pointer = 3 Then             '三组对比完全一致

.Rows(TempRow).Delete       '删除当前行

End If

Next TempRow

End With

End Sub

追问

我运行后什么也没发生的？

追答

With ActiveSheet
表示对当前活动工作表进行操作。如果你要比对的工作表不是当前活动工作表，那么就不会操作的。
还有，建议你使用 F8 键进行单步调试。

Answer 2

试试这个：
Sub 比对()
Dim lastRow, i As Long
Dim same_b, same_c, same_d As Integer
lastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row '获取最大行值
'设置3个变量，存放3对列内容相等的计数；初始化为0
same_b = 0
same_c = 0
same_d = 0
For i = 2 To lastRow
If Cells(i, "B").Value <> Cells(i, "F").Value Then
Cells(i, "B").Interior.Color = 255
Cells(i, "F").Interior.Color = 255
Else
same_b = same_b + 1 'B、F列同一行值相等就计数+1
End If
If Cells(i, "C").Value <> Cells(i, "H").Value Then
Cells(i, "C").Interior.Color = 255
Cells(i, "H").Interior.Color = 255
Else
same_c = same_c + 1 'C、H列同一行值相等就计数+1
End If
If Cells(i, "D").Value <> Cells(i, "G").Value Then
Cells(i, "D").Interior.Color = 255
Cells(i, "G").Interior.Color = 255
Else
same_d = same_d + 1 'D、G列同一行值相等就计数+1
End If
Next
If same_c = lastRow - 1 Then '当同行相等计数=区域行数时，说明列内容全部相等，删除列；下同
Columns("H:H").Delete Shift:=xlToLeft
End If
If same_d = lastRow - 1 Then
Columns("G:G").Delete Shift:=xlToLeft
End If
If same_b = lastRow - 1 Then
Columns("F:F").Delete Shift:=xlToLeft
End If
MsgBox "比对已完成！"
End Sub