用PYTHON程式,進行2個EXCEL表,欄位比較

 
比較2個EXCEL表格，檢視上月 及 本月之差異，為加快人工檢視處理，分別各捉取前7筆資料,並對欄位進行比較處理之VBA程式;
同時亦將完整月份(上月/本月)資料載入不同頁籤


Sub CompareExcelFiles()
Application.DisplayAlerts = False
'控制 Excel 應用程式是否顯示警告訊息。
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim i As Integer, j As Integer
    Dim fd As FileDialog
    Dim strFilepPre As String
    Dim strFileCur As String
    
    
    ' '開啟檔案GUI對話窗格，選取上月EXCEL檔，將路徑傳給strFilePre，供開啟比對用
    
     Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Title = "Select a XLS (上月)"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls*", 1
        .InitialFileName = "C:\Users\Downloads"
        .AllowMultiSelect = False
        If .Show = True Then
            strFilePre = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    
    Set wb1 = Workbooks.Open(strFilepre)
    Set ws1 = wb1.Worksheets(1)
    
    
    '開啟檔案GUI對話窗格，選取本月EXCEL檔，，將路徑傳給strFileCur，供開啟比對用
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Title = "Select a XLS (本月)"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls*", 1
        .InitialFileName = "C:\Users\Downloads"
        .AllowMultiSelect = False
        If .Show = True Then
            strFileCur = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    
    ' 開啟本月.xls  ,路徑請自行修改
    Set wb2 = Workbooks.Open(strFileCur)
    Set ws2 = wb2.Worksheets(1)
    
    ' 建立檢核結果.xls
    Set wb3 = Workbooks.Add
    Set ws3 = wb3.Worksheets(1)
    
    ' 將上月.xls複製到「檢核結果.xls」的"上月"工作表
    On Error Resume Next
    Set ws1Copy = wb3.Worksheets("上月")
    If ws1Copy Is Nothing Then
        Set ws1Copy = wb3.Worksheets.Add(Before:=wb3.Worksheets(1))
        ws1Copy.Name = "上月"
    End If
    ws1.UsedRange.Copy ws1Copy.Range("A1")
    
    ' 將本月.xls複製到「檢核結果.xls」的"本月"工作表
    On Error Resume Next
    Set ws2Copy = wb3.Worksheets("本月")
    If ws2Copy Is Nothing Then
        Set ws2Copy = wb3.Worksheets.Add(Before:=wb3.Worksheets(1))
        ws2Copy.Name = "本月"
    End If
    ws2.UsedRange.Copy ws2Copy.Range("A1")
    
    ' 比較標題欄並將結果寫入「檢核結果.xls」的第1列
    For i = 1 To ws1.UsedRange.Columns.Count
        If ws1.Cells(1, i).Value = ws2.Cells(1, i).Value Then
            ws3.Cells(1, i).Value = "相同"
        Else
            ws3.Cells(1, i).Value = "不同"
        End If
    Next i
    
    ' 保存檢核結果.xls
    wb3.SaveAs "檢核結果.xls"
    
    ' 開啟檢核結果.xls
    Set wb3 = Workbooks.Open("檢核結果.xls")
    Set ws3 = wb3.Worksheets("工作表1")
    
    Windows("檢核結果.xls").Activate
    ws3.Cells.Select
    Selection.ClearContents
    Windows("活頁簿1.xlsm").Activate
    
    
    ' 將上月.xls前6筆(含標題列)複製到檢核結果.xls
    ws3.Cells(2, ws3.UsedRange.Columns.Count + 2) = "上月檢核ˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇ"
    ws1.Range("A1").Resize(5, ws1.UsedRange.Columns.Count).Copy ws3.Cells(3, ws3.UsedRange.Columns.Count + 2)
    ' 將本月.xls前6筆(含標題列)複製到檢核結果.
    ws3.Cells(ws3.UsedRange.Columns.Count + 5, 5) = "本月檢核ˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇ"
    ws2.Range("A1").Resize(7, ws2.UsedRange.Columns.Count).Copy ws3.Cells(ws3.UsedRange.Columns.Count + 6, 5)
    
    ' 關閉工作簿
    wb1.Close SaveChanges:=False
    wb2.Close SaveChanges:=False
 '  wb3.Close SaveChanges:=True
 
    
    ' 釋放物件
    Set ws1 = Nothing
    Set ws2 = Nothing
    Set ws3 = Nothing
    Set wb1 = Nothing
    Set wb2 = Nothing
 '  Set wb3 = Nothing
    

    Windows("檢核結果.xls").Activate
    Sheets("工作表1").Select
    
 
 Application.DisplayAlerts = True
'控制 Excel 應用程式是否顯示警告訊息。
 
 
End Sub



相關查詢:
INQUIREというアドインを使用して、2つのファイルを比較して違いを表示する (經由 Inquire增益集比對2個EXCEL)

スプレッドシート比較の基本的な作業 (Compare two or more worksheets at the same time)

複数のワークシートを同時に比較する