比较两个Excel工作表中的第一列,并将差异更新为文本文件

时间:2015-11-05 13:30:36

标签: excel excel-vba vbscript vba

我们希望比较两个不同Excel工作表中第一列的输出,并将差异更新为文本文件。这只是将excel1中的A1数据与excel2的A1数据进行比较并附加到文本文件中:

Dim objExcel,ObjWorkbook,objsheet,ObjWorkbook1,objsheet1,Originalvalue,filesys, filetxt

Const ForReading = 1, ForWriting = 2, ForAppending = 8 

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("D:\Test\copy.xlsx")
set objsheet = objExcel.ActiveWorkbook.Worksheets(1)
Set objWorkbook1 = objExcel.Workbooks.Open("D:\Test\Original.xlsx")
set objsheet1 = objExcel.ActiveWorkbook.Worksheets(1)

Originalvalue = objsheet.Cells(1,1).value

Copyvalue = objsheet1.Cells(1,1).value

If Originalvalue = Copyvalue then

Set filesys = CreateObject("Scripting.FileSystemObject") 
Set filetxt = filesys.OpenTextFile("D:\Test\output.txt", ForAppending, True) 
filetxt.WriteLine(Originalvalue) 
filetxt.Close

msgbox Originalvalue

else 

Set filesys = CreateObject("Scripting.FileSystemObject") 
Set filetxt = filesys.OpenTextFile("D:\Test\output.txt", ForAppending, True) 
filetxt.WriteLine(Copyvalue) 
filetxt.Close

msgbox Copyvalue

End If

objExcel.ActiveWorkbook.Close
objExcel.Workbooks.Close
objExcel.Application.Quit

如何为所有 A列中的数据做到这一点?

1 个答案:

答案 0 :(得分:1)

这会比较文件,如果复制文件中有不同的值,则将其放入文本文件中...如果值相等,则忽略它们。不确定这是否是您要查找的行为,但是你至少可以看到如何遍历文件以比较所有记录

Dim objExcel, ObjWorkbook, objsheet, ObjWorkbook1, objsheet1, Originalvalue, filesys, filetxt
Dim objsheet_LastRow As Long, objsheet1_LastRow, LastRow As Long, RowCounter As Long, CopyValue

Const ForReading = 1, ForWriting = 2, ForAppending = 8

'are you doing this because you are running this outside of excel?
'if not then this doesn't have to look as complicated as it is

Set objExcel = CreateObject("Excel.Application")
Set ObjWorkbook = objExcel.Workbooks.Open("D:\Test\copy.xlsx")
Set objsheet = objExcel.ActiveWorkbook.Worksheets(1)
Set ObjWorkbook1 = objExcel.Workbooks.Open("D:\Test\Original.xlsx")
Set objsheet1 = objExcel.ActiveWorkbook.Worksheets(1)

Set filesys = CreateObject("Scripting.FileSystemObject")
Set filetxt = filesys.OpenTextFile("D:\Test\output.txt", ForAppending, True)

'find the last row of data in each sheet, this will only go the end of the shorter file
objsheet_LastRow = objsheet.Cells(100000, 1).End(xlUp).Row
objsheet1_LastRow = objsheet1.Cells(100000, 1).End(xlUp).Row
LastRow = Application.WorksheetFunction.Min(objsheet_LastRow, objsheet1_LastRow)

For RowCounter = 1 To LastRow
    Originalvalue = objsheet.Cells(RowCounter, 1).Value
    CopyValue = objsheet1.Cells(RowCounter, 1).Value
    'if values are different, put the new value in a txt file
    If Originalvalue <> CopyValue Then filetxt.WriteLine (CopyValue)
Next RowCounter

filetxt.Close
ObjWorkbook.Close False
ObjWorkbook1.Close False
'objExcel.ActiveWorkbook.Close
'objExcel.Workbooks.Close
objExcel.Application.Quit

TODO:错误捕获