2014-02-22 30 views
0

我需要比較來自兩個數據庫的數據。所以,我將這些數據填充到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 

這裏完成了單元明智的比較。現在,我需要根據數據類型進行比較。如果它是一個數字,那麼我需要檢查直到兩位小數。你能幫我解決這個問題嗎?

+0

我不完全理解你的問題,但相信函數'VarType'可以滿足你的需要。 –

+1

您可以嘗試'IsNumeric(colval1)'並根據結果切換等效性測試。對於數字上的二進制精度,「Round(colval1,2)'可以完成這項工作。 –

回答

0

以下代碼已解決我的目的。 @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