VBA二次學習筆記（2）——兩個Excel表內容比較

說明（2018-9-3 22:38:58）：

1. 就是以前問同事要來的做業，有兩個格式同樣的Excel文件，一個是正確答案，一個是員工做答的。經過代碼將兩個文件進行比對，把不一樣之處列出來。

正文：

Sub test1() Dim wb1 As Worksheet Dim wb2 As Worksheet Dim wb As Worksheet Set wb1 = Workbooks("1.xlsx").Sheets(1) Set wb2 = Workbooks("2.xlsx").Sheets(1) Set wb = Workbooks("test.xlsm").Sheets(1) Dim n As Integer n = 2
    For i = 3 To 14
      If wb1.Range("b" & i).Value <> wb2.Range("b" & i).Value Then wb.Range("a" & n).Value = wb1.Range("a" & i).Value wb.Range("b" & n).Value = wb1.Range("b" & i).Value wb.Range("c" & n).Value = wb2.Range("b" & i).Value n = n + 1
      End If
    Next
    
    For i = 24 To 31
      If wb1.Range("b" & i).Value <> wb2.Range("b" & i).Value Then wb.Range("a" & n).Value = wb1.Range("a" & i).Value wb.Range("b" & n).Value = wb1.Range("b" & i).Value wb.Range("c" & n).Value = wb2.Range("b" & i).Value n = n + 1
      End If
    Next
End Sub

效果：

1.xlsx和2.xlsx，有兩個數字不同

      

在宏文件所在的Excel裏的顯示結果：

 

總結：

1. 主要使用了獲取工做簿的方法WorkBooks()；用了兩個for循環，由於表格不連續；用了一個變量n，控制在主表中向下排列不一樣數據。

2.  WorkBooks()獲取工做簿須要文件打開，下一步能夠使用open方法，在不用提早打開文件的條件下完成操做。

附件：

 

Sub test1()
    Dim wb1 As Worksheet
    Dim wb2 As Worksheet
    Dim wb As Worksheet
    Dim fileCheck, fileAnswer As String
    fileCheck = "Cassie Jiang.xlsx"
    fileAnswer = "Correct Answer.xlsx"
    '判斷文件是否已經打開，若是打開，提示關閉
    Set sheetCheck = Workbooks.Open(ThisWorkbook.path + "\" + fileCheck).Sheets(1)
    Set sheetAnswer = Workbooks.Open(ThisWorkbook.path + "\" + fileAnswer).Sheets(1)
    Set sheetError = Workbooks(fileAnswer).Sheets(2)
    Dim n As Integer
    n = 2
    For i = 3 To 5
      If LCase(Replace(sheetCheck.Range("d" & i).Value, " ", "")) <> LCase(Replace(sheetAnswer.Range("d" & i).Value, " ", "")) Then
        sheetError.Range("a" & n).Value = sheetCheck.Range("D6").Value '姓名
        sheetError.Range("b" & n).Value = sheetCheck.Range("b" & i).Row 'Row#
        sheetError.Range("c" & n).Value = sheetCheck.Range("b" & i).Value 'Item(b3,c3合併了，因此要用b3)
        sheetError.Range("d" & n).Value = sheetCheck.Range("d" & i).Value 'Trainee's Answer
        sheetError.Range("e" & n).Value = sheetAnswer.Range("d" & i).Value 'Correct Answer
        n = n + 1
      End If
    Next
    
    For i = 9 To 61
      If LCase(Replace(sheetCheck.Range("d" & i).Value, " ", "")) <> LCase(Replace(sheetAnswer.Range("d" & i).Value, " ", "")) Then
        sheetError.Range("a" & n).Value = sheetCheck.Range("D6").Value
        sheetError.Range("b" & n).Value = sheetCheck.Range("b" & i).Row
        sheetError.Range("c" & n).Value = sheetCheck.Range("c" & i).Value
        sheetError.Range("d" & n).Value = sheetCheck.Range("d" & i).Value
        sheetError.Range("e" & n).Value = sheetAnswer.Range("d" & i).Value
        n = n + 1
      End If
    Next

    For i = 66 To 107
      If LCase(Replace(sheetCheck.Range("d" & i).Value, " ", "")) <> LCase(Replace(sheetAnswer.Range("d" & i).Value, " ", "")) Then
        sheetError.Range("a" & n).Value = sheetCheck.Range("D6").Value
        sheetError.Range("b" & n).Value = sheetCheck.Range("b" & i).Row
        sheetError.Range("c" & n).Value = sheetCheck.Range("c" & i).Value
        sheetError.Range("d" & n).Value = sheetCheck.Range("d" & i).Value
        sheetError.Range("e" & n).Value = sheetAnswer.Range("d" & i).Value
        n = n + 1
      End If
    Next


    Workbooks(fileCheck).Close
    Workbooks(fileAnswer).Close (True)
    
End Sub

 修改後：

Sub Check()
    Dim sheetCheck, sheetAnswer, sheetError As Worksheet

    '篩選、獲取trainee文件名
    For i = 1 To Workbooks.Count
        If Workbooks(i).Name <> "Correct Answer.xlsx" And Workbooks(i).Name <> "micro.xlsm" And LCase(Workbooks(i).Name) <> "personal.xlsb" Then
        Set sheetCheck = Workbooks(i).Sheets(1)
        Exit For
        End If
    Next
    Set sheetAnswer = Workbooks("Correct Answer.xlsx").Sheets(1) '獲取Answer工做表
    Set sheetError = Workbooks("Correct Answer.xlsx").Sheets(2) '獲取Error工做表
    
    '對比前清除Error比對記錄
    Dim m As Integer
    m = sheetError.UsedRange.Rows.Count
    sheetError.Rows("2:" & m).ClearContents
    
    '設置Error裏的行號
    Dim n As Integer
    n = 2
    
    '循環對比
    For i = 3 To 5
      If LCase(Replace(sheetCheck.Range("d" & i).Value, " ", "")) <> LCase(Replace(sheetAnswer.Range("d" & i).Value, " ", "")) Then
        sheetError.Range("a" & n).Value = sheetCheck.Range("D6").Value '姓名
        sheetError.Range("b" & n).Value = sheetCheck.Range("b" & i).Row 'Row#
        sheetError.Range("c" & n).Value = sheetCheck.Range("b" & i).Value 'Item(b3,c3合併了，因此要用b3)
        sheetError.Range("d" & n).Value = sheetCheck.Range("d" & i).Value 'Trainee's Answer
        sheetError.Range("e" & n).Value = sheetAnswer.Range("d" & i).Value 'Correct Answer
        n = n + 1
      End If
    Next

    For i = 9 To 107
      If LCase(Replace(sheetCheck.Range("d" & i).Value, " ", "")) <> LCase(Replace(sheetAnswer.Range("d" & i).Value, " ", "")) Then
        sheetError.Range("a" & n).Value = sheetCheck.Range("D6").Value
        sheetError.Range("b" & n).Value = sheetCheck.Range("b" & i).Row
        sheetError.Range("c" & n).Value = sheetCheck.Range("c" & i).Value '這裏是c了
        sheetError.Range("d" & n).Value = sheetCheck.Range("d" & i).Value
        sheetError.Range("e" & n).Value = sheetAnswer.Range("d" & i).Value
        n = n + 1
      End If
    Next

    
End Sub