【问题标题】:Compare first column in each of two Excel sheets and update the differences to a text file比较两个 Excel 工作表中的第一列并将差异更新为文本文件
【发布时间】:2015-11-05 13:30:35
【问题描述】:

我们想比较两个不同 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列的数据做到这一点?

【问题讨论】:

  • 两个文件的记录数相同吗?而且您确实意识到这只会输出您的“复制”文件的txt副本,对吗? IF 语句的两个分支都会将 Copyvalue 的值写入 txt 文件。这真的是你想要的行为吗?
  • 不,这两个文件不会有相同数量的记录。
  • 感谢您指出.. (Copyvalue) 不是必需的。输出文本文件应仅包含差异值。

标签: excel vbscript vba


【解决方案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:错误捕获

【讨论】:

  • 谢谢。在 for & if 循环和使用 DIM 声明变量时处理的错误,但无法克服第 19 行引发的错误,即 Unknown runtime error。请帮忙。
猜你喜欢
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2012-10-28
  • 2021-10-03
  • 2021-11-30
相关资源
最近更新 更多