时间戳

首页 > 解决方案 > VBA宏：比较/检查3张纸并返回差异值

excel - VBA宏：比较/检查3张纸并返回差异值

问题描述

我有 3 张纸需要检查它们是否具有相同的价值。在表格 MM、PP 和 CO 中，直到最后一行的 B6 列上的所有值都应相同。如果存在差异值，则不同的值应突出显示（颜色为红色）。

但是，我的语法没有运行。如果范围内有一个空列，该语法就可以读取。这是我的语法..不包括突出显示。首先，我试图将差异值放在其他表上。但是，失败了。谢谢你。

Sub MatchValue()

Dim x As Integer
Dim y As Integer
Dim z As Integer

LastRowB = Cells(Rows.Count, "B").End(xlUp).Row

x = ActiveWorkbook.Worksheets("MM").Range("B6:B" & LastRowB).Cells.SpecialCells(xlCellTypeConstants).Count
y = ActiveWorkbook.Worksheets("PP").Range("B6:B" & LastRowB).Cells.SpecialCells(xlCellTypeConstants).Count
z = ActiveWorkbook.Worksheets("CO").Range("B6:B" & LastRowB).Cells.SpecialCells(xlCellTypeConstants).Count

If x <> y Then
MsgBox "MM <> PP", vbCritical, "Error Report"
End If
If y <> z Then
MsgBox "PP <> CO", vbCritical, "Error Report"
End If
If z <> x Then
MsgBox "CO <> MM", vbCritical, "Error Report"
End If

SheetMM = "MM"
DataColumnMM = "B6"
SheetPP = "PP"
DataColumnPP = "B6"
SheetCO = "CO"
DataColumnCO = "B6"
SheetUnmatched = "Data Unmatched"
DataColumnUnmatched = "A1"

DataRowMM = Range(DataColumnMM).Row
DataColMM = Range(DataColumnMM).Column
DataRowPP = Range(DataColumnPP).Row
DataColPP = Range(DataColumnPP).Column
DataRowCo = Range(DataColumnCO).Row
DataColCo = Range(DataColumnCO).Column
DataRowUnmatched = Range(DataColumnUnmatched).Row
DataColUnmatched = Range(DataColumnUnmatched).Column


LastDataMM = Sheets(SheetMM).Cells(Rows.Count, DataColMM).End(xlUp).Row
LastDataPP = Sheets(SheetPP).Cells(Rows.Count, DataColPP).End(xlUp).Row
LastDataCO = Sheets(SheetCO).Cells(Rows.Count, DataColCo).End(xlUp).Row
LastDataUnmathced = Sheets(SheetUnmatched).Cells(Rows.Count, DataColUnmatched).End(xlUp).Row

    For counter = DataRowMM To LastDataRowMM
        If WorksheetFunction.CountIf(LastDataPP, counter) = 0 Then
            LastDataUnmathced.Offset(1) = counter
        End If
    Next
    For counter = DataRowMM To LastDataRowMM
        If WorksheetFunction.CountIf(LastDataCO, counter) = 0 Then
            LastDataUnmathced.Offset(1) = counter
        End If
    Next
        For counter = DataRowPP To LastDataRowPP
        If WorksheetFunction.CountIf(LastDataCO, counter) = 0 Then
            LastDataUnmathced.Offset(1) = counter
        End If
    Next

End Sub

标签： excelvba

解决方案

根据您提供的信息，您希望：

  1. 检查三个表中的三个表ActiveWorkbook
  2. 检查表范围中是否存在相同数量的常量
  3. 将三张纸之间的值不相同的单元格突出显示为红色

我简化了代码以实现这些目标

Sub MatchValue()

  Dim Range1 As Range, Range2 As Range, Range3 As Range

  With ActiveWorkbook
    With .Sheets("MM")            'First Sheet Name
      Set Range1 = .Range("B6")   'Address of first row on First Sheet
      Set Range1 = .Range(Range1, .Cells(.Rows.Count, Range1.Column).End(xlUp))
    End With

    With .Sheets("PP")            'Second Sheet Name
      Set Range2 = .Range("B6")   'Address of first row on second Sheet
      Set Range2 = .Range(Range2, .Cells(.Rows.Count, Range2.Column).End(xlUp))
    End With

    With .Sheets("CO")            'Third Sheet Name
      Set Range3 = .Range("B6")   'Address of first row on third Sheet
      Set Range3 = .Range(Range3, .Cells(.Rows.Count, Range3.Column).End(xlUp))
    End With
  End With

'Delete this part if you don't want to remove the existing fill (might be handy)
  Range1.Interior.Pattern = xlNone
  Range2.Interior.Pattern = xlNone
  Range3.Interior.Pattern = xlNone

'Checks to see if the same number of constants exist within the test ranges
  If Range1.SpecialCells(xlCellTypeConstants).Count <> _
     Range2.SpecialCells(xlCellTypeConstants).Count Then
    MsgBox "Range 1 and Range 2 constant count doesn't match", vbCritical, "Error Report"
  ElseIf Range2.SpecialCells(xlCellTypeConstants).Count <> _
         Range3.SpecialCells(xlCellTypeConstants).Count Then
    MsgBox "Range 1 and Range 2 constant count doesn't match", vbCritical, "Error Report"
  End If

  Dim Temp1 As Variant, Temp2 As Variant, Temp3 As Variant, x As Long

'Checks to see if all the values entered are the same, if not, fills them red
  Temp1 = Range1.Value
  Temp2 = Range2.Value
  Temp3 = Range3.Value

  For x = 1 To UBound(Temp1, 1)
    If Temp1(x, 1) <> Temp2(x, 1) Or _
       Temp2(x, 1) <> Temp3(x, 1) Then
      Range1.Cells(x, 1).Interior.Color = RGB(255, 0, 0)
      Range2.Cells(x, 1).Interior.Color = RGB(255, 0, 0)
      Range3.Cells(x, 1).Interior.Color = RGB(255, 0, 0)
    End If
  Next x

End Sub

推荐阅读