VBA secondary study notes (2) - two tables compare the contents of Excel VBA secondary study notes (2) - Compare two Excel table of contents

VBA secondary study notes (2) - Compare two Excel table of contents

Description (2018-9-3 22:38:58):

1. Before that asked my colleagues to come to work, there are two formats like Excel files, one is the correct answer, one answer of the staff. The two documents are aligned by a code different from the listed.

text:

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

effect:

1.xlsx and 2.xlsx, there are two numbers are not the same

      

Display the results in an Excel file is located in the macro:

 

to sum up:

1. The main use of the method of obtaining the workbook WorkBooks (); for loops with the two, as a discontinuous form; use of a variable n, the different arrangement of the control data in the main table down.

2. WorkBooks () Gets workbook need to open the file, the next step may be to use open methods, to complete the operation without opening the file in advance conditions.

annex:

 

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

说明（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