Question

我需要比较来自两个数据库的数据。因此，我将数据填充到excel表中，并使用以下VBA代码进行比较。

Sub Compare2WorkSheets(ws1 As Worksheet, ws2 As Worksheet)

  Dim ws1row As Long, ws2row As Long, ws1col As Integer, ws2col As Integer 
  Dim maxrow As Long, maxcol As Integer, colval1 As String, colval2 As String 
  Dim report As Workbook, difference As Long 
  Dim row As Long, col As Integer 

  Set report = Workbooks.Add 

  With ws1.UsedRange 
    ws1row = .Rows.Count 
    ws1col = .Columns.Count 
  End With 

  With ws2.UsedRange 
    ws2row = .Rows.Count 
    ws2col = .Columns.Count
  End With

  maxrow = ws1row 
  maxcol = ws1col 
  If maxrow < ws2row Then maxrow = ws2row 
  If maxcol < ws2col Then maxcol = ws2col 

  difference = 0 

  For col = 1 To maxcol 
    For row = 1 To maxrow 
      colval1 = "" 
      colval2 = "" 
      colval1 = ws1.Cells(row, col).Formula 
      colval2 = ws2.Cells(row, col).Formula 
      If colval1 <> colval2 Then 
        difference = difference + 1 
        Cells(row, col).Formula = colval1 & "<> " & colval2 
        Cells(row, col).Interior.Color = 255 
        Cells(row, col).Font.ColorIndex = 2 
        Cells(row, col).Font.Bold = True 
      End If 
    Next row 
  Next col 

  Columns("A:B").ColumnWidth = 25 
  report.Saved = True 

  If difference = 0 Then 
    report.Close False 
  End If 
  Set report = Nothing 
  MsgBox difference & " cells contain different data! ", vbInformation, _
         "Comparing Two       Worksheets" 
End Sub

这里进行细胞比较。现在，我需要根据数据类型进行比较。就像它是一个数字，然后我需要检查直到两位小数。你能帮我解决这个问题。

Answer 1

以下代码解决了我的目的。 @andy非常感谢。您的意见有助于解决我的问题。

Sub Compare2WorkSheets(ws1 As Worksheet, ws2 As Worksheet)
Dim ws1row As Long, ws2row As Long, ws1col As Integer, ws2col As Integer
Dim maxrow As Long, maxcol As Integer, colval1 As String, colval2 As String
Dim report As Workbook, difference As Long
Dim row As Long, col As Integer
Dim lvalue As Boolean
Set report = Workbooks.Add
With ws1.UsedRange
ws1row = .Rows.Count
ws1col = .Columns.Count
End With
With ws2.UsedRange
ws2row = .Rows.Count
ws2col = .Columns.Count
End With
maxrow = ws1row
maxcol = ws1col
If maxrow < ws2row Then maxrow = ws2row
If maxcol < ws2col Then maxcol = ws2col
difference = 0
For col = 1 To maxcol
  For row = 1 To maxrow
  colval1 = ""
  colval2 = ""
  colval1 = ws1.Cells(row, col).Formula
  colval2 = ws2.Cells(row, col).Formula

  If IsNumeric(colval1) Or IsNumeric(colval2) Then

     If Round(Val(colval1), 2) <> Round(Val(colval2), 2) Then
        difference = difference + 1
        Cells(row, col).Formula = "DIFF " & colval1 & "<> " & colval2
        Cells(row, col).Interior.Color = 255
        Cells(row, col).Font.ColorIndex = 2
        Cells(row, col).Font.Bold = True
     End If

  Else
     If colval1 <> colval2 Then
        difference = difference + 1
        Cells(row, col).Formula = "DIFF " & colval1 & "<> " & colval2
        Cells(row, col).Interior.Color = 255
        Cells(row, col).Font.ColorIndex = 2
        Cells(row, col).Font.Bold = True
     End If
  End If
 Next row
 Next col
 Columns("A:B").ColumnWidth = 25
 report.Saved = True
 If difference = 0 Then
 report.Close False
 End If
 Set report = Nothing
 MsgBox difference & " cells contain different data! ", vbInformation, "Comparing Two    Worksheets"
 End Sub

根据格式比较数据

1 个答案: