Excel VBA比较两个工作簿将差异写入文本文件

时间:2016-05-16 03:32:56

标签: excel vba excel-vba

经过多次语法攻击后,我有以下代码工作,但我想使用错误检查来确定文件是否已使用字符串打开。

(披露:我已经复制了来自我将在发现时链接的来源的比较表)

尝试替换此代码

Set wbkA = Workbooks.Open(FileName:=wba)

Set wBook = Workbooks(wba) 'run time error subscript out of range
If wBook Is Nothing Then
   Set wbkA = Workbooks.Open(FileName:=wba)
End If

但是我对字符串wba有语法问题。在这里使用字符串的正确方法是什么?

Sub RunCompare_WS2()

  Dim i As Integer
  Dim wba, wbb As String
  Dim FileName As Variant
  Dim wkbA As Workbook
  Dim wkbB As Workbook
  Dim wBook As Workbook

  wba = "C:\c.xlsm"
  wbb = "C:\d.xlsm"

  'Set wBook = Workbooks(FileName:=wba) 'compiler error named argument not found

  'Set wBook = Workbooks(wba) 'run time error subscript out of range
  'If wBook Is Nothing Then
    'Set wbkA = Workbooks.Open(FileName:=wba)
  'End If

  Set wbkA = Workbooks.Open(FileName:=wba)
  Set wbkB = Workbooks.Open(FileName:=wbb)

  For i = 1 To Application.Sheets.Count
    Call compareSheets(wbkA.Sheets(i), wbkB.Sheets(i))
  Next i

  wbkA.Close SaveChanges:=True
  wbkB.Close SaveChanges:=False
  MsgBox "Completed...", vbInformation
End Sub

Sub compareSheets(shtSheet1 As Worksheet, shtSheet2 As Worksheet)

  Dim mycell As Range
  Dim mydiffs As Integer
  Dim DifFound As Boolean

  DifFound = False
  sDestFile = "C:\comp-wb.txt"
  DestFileNum = FreeFile()
  Open sDestFile For Append As DestFileNum

  'For each cell in sheet2 that is not the same in Sheet1, color it lightgreen in first file
  For Each mycell In shtSheet1.UsedRange
    If Not mycell.Value = shtSheet2.Cells(mycell.Row, mycell.Column).Value Then
        If DifFound = False Then
          Print #DestFileNum, "Row,Col" & vbTab & vbTab & "A Value" & vbTab & vbTab & "B Value"
          DifFound = True
        End If
        mycell.Interior.Color = 5296274 'LightGreen
        Print #DestFileNum, mycell.Row & "," & mycell.Column, mycell.Value, shtSheet2.Cells(mycell.Row, mycell.Column).Value '& vbInformation
        mydiffs = mydiffs + 1
    End If
  Next

  Print #DestFileNum, mydiffs & " differences found in " & shtSheet1.Name

  Close #DestFileNum
End Sub

3 个答案:

答案 0 :(得分:1)

您可以使用On Error Resume Next忽略任何错误:

Const d As String = "C:\"
wba = "c.xlsm"

On Error Resume Next
Set wBook = Workbooks(wba) 
On Error Goto 0
If wBook Is Nothing Then
  Set wbkA = Workbooks.Open(d & wba) 'join string d & wba
End If

答案 1 :(得分:0)

这将检查您是否打开文件。

Option Explicit
Function InputOpenChecker(InputFilePath) As Boolean
Dim WB As Workbook
Dim StrFileName As String
Dim GetFileName As String
Dim IsFileOpen As Boolean

InputOpenChecker = False

'Set Full path and name of file to check if already opened.
GetFileName = Dir(InputFilePath)
StrFileName = InputFilePath & GetFileName

IsFileOpen = False
    For Each WB In Application.Workbooks
        If WB.Name = GetFileName Then
            IsFileOpen = True
    Exit For
        End If
    Next WB

如果您没有打开它,请检查是否有其他人。

On Error Resume Next
' If the file is already opened by another process,
' and the specified type of access is not allowed,
' the Open operation fails and an error occurs.
Open StrFileName For Binary Access Read Write Lock Read Write As #1
Close #1

' If an error occurs, the document is currently open.
If Err.Number <> 0 Then
    'Set the FileLocked Boolean value to true
    FileLocked = True
    Err.Clear
End If

错误的一个原因可能是包含&#34; FileName:=&#34;在Workbooks.Open中。尝试;

  Set wbkA = Workbooks.Open(wba)
  Set wbkB = Workbooks.Open(wbb)

答案 2 :(得分:0)

修正了我的代码,并为了清晰起见而重新发布了更正。 注意我移动到C:\ temp,因为不应该使用写入根C:\文件夹,因为许多工作计算机已锁定根文件夹以保证安全性,正如我的同事刚刚发现的那样!

  Sub RunCompare_WS9() 'compare two WKbooks, all sheets write diff to text file

  Dim i As Integer
  Dim wba, wbb As String
  Dim FileName As Variant
  Dim wkbA As Workbook
  Dim wkbB As Workbook
  Dim wbook1 As Workbook
  Dim wbook2 As Workbook
  wba = "C:\test\c.xlsm"
  wbb = "C:\test\d.xlsm"

On Error Resume Next
Set wbook1 = Workbooks(wba)
On Error GoTo 0
  If wbook1 Is Nothing Then
    Set wbkA = Workbooks.Open(wba)
  End If

On Error Resume Next
Set wbook2 = Workbooks(wbb)
On Error GoTo 0
  If wbook2 Is Nothing Then
    Set wbkB = Workbooks.Open(wbb)
  End If

  For i = 1 To Application.Sheets.Count
    Call compareSheets(wbkA.Sheets(i), wbkB.Sheets(i))
  Next i

  wbkA.Close SaveChanges:=True
  wbkB.Close SaveChanges:=False
  MsgBox "Completed...", vbInformation
End Sub

Sub compareSheets(shtSheet1 As Worksheet, shtSheet2 As Worksheet)

  Dim mycell As Range
  Dim mydiffs As Integer
  Dim DifFound As Boolean

  DifFound = False
  sDestFile = "C:\Test\comp2-wb.txt"
  DestFileNum = FreeFile()
  Open sDestFile For Append As DestFileNum

  'For each cell in sheet2 that is not the same in Sheet1, color it lightgreen in first file
  For Each mycell In shtSheet1.UsedRange
    If Not mycell.Value = shtSheet2.Cells(mycell.Row, mycell.Column).Value Then
        If DifFound = False Then
          Print #DestFileNum, "Row,Col" & vbTab & vbTab & "A Value" & vbTab & vbTab & "B Value"
          DifFound = True
        End If
        mycell.Interior.Color = 5296274 'LightGreen
        Print #DestFileNum, mycell.Row & "," & mycell.Column, mycell.Value, shtSheet2.Cells(mycell.Row, mycell.Column).Value '& vbInformation
        mydiffs = mydiffs + 1
    End If
  Next

  Print #DestFileNum, mydiffs & " differences found in " & shtSheet1.Name

  Close #DestFileNum
End Sub