Question

我有以下代码两个代码都可以单独工作，但是当它们合并时会产生错误

“未设置对象变量”

需要在打开的新工作簿的工作表中设置ws1和ws2。我试过这个工作簿和活动工作簿，但是它考虑了宏所在的工作簿，而不是新选择的文件。

下面的代码要求选择一个文件，然后比较2张数据并显示新工作簿中的差异（但我希望它显示第3页中的差异，我该怎么做）。我是VBA的新手。

Private Sub AutomateCompare()
    Dim fileBrowse As FileDialog
    Dim shtNum As Integer

    Set fileBrowse = Application.FileDialog(msoFileDialogOpen)
    If fileBrowse.Show = True Then wbPath = fileBrowse.SelectedItems(1)

    With Workbooks.Open(wbPath)
        shtNum = InputBox("Enter the number of the sheet you want to use.")
    End With
End Sub


Sub Compare2Worksheets(ws1 As Worksheet, ws2 As Worksheet)
    Dim ws1row As Long, ws2row As Long, ws1col As Integer, ws2col As Integer
    Dim maxrow As Long, maxcol As Integer, colval1 As String, colval2 As String
    Dim report As Workbook, difference As Long
    Dim row As Long, col As Integer
    Set report = Workbooks.Add

    With ws1.UsedRange
        ws1row = .Rows.Count
        ws1col = .Columns.Count
    End With

    With ws2.UsedRange
        ws2row = .Rows.Count
        ws2col = .Columns.Count
    End With

    maxrow = ws1row
    maxcol = ws1col

    If maxrow < ws2row Then maxrow = ws2row
    If maxcol < ws2col Then maxcol = ws2col

    difference = 0

    For col = 1 To maxcol
        For row = 1 To maxrow
            colval1 = ""
            colval2 = ""
            colval1 = ws1.Cells(row, col).Formula
            colval2 = ws2.Cells(row, col).Formula

            If colval1 <> colval2 Then
                difference = difference + 1
                Cells(row, col).Formula = colval1 & "<> " & colval2
                Cells(row, col).Interior.Color = 255
                Cells(row, col).Font.ColorIndex = 2
                Cells(row, col).Font.Bold = True
            End If
        Next row 
    Next col

    Columns("a:b").ColumnWidth = 25
    report.Saved = True

    If difference = 0 Then
        report.Close False
    End If
    Set report = Nothing

    MsgBox difference & " cells contain different data! ", vbInformation, "comparing two worksheets"
End Sub


Sub CommandButton1_Click()
    Dim ws As Worksheet, ws1 As Worksheet, ws2 As Worksheet
    Call AutomateCompare
    Call Compare2Worksheets(ws1, ws2)
End Sub

Answer 1

要从AutomateCompare（）过程获取工作表，请将其更改为Function：

private Function AutomateCompare() As Worksheet
Dim fileBrowse As FileDialog
Dim shtNum As Integer
Set fileBrowse = Application.FileDialog(msoFileDialogOpen)
If fileBrowse.Show = True Then wbPath = fileBrowse.SelectedItems(1)
With Workbooks.Open(wbPath)
    shtNum = InputBox("Enter the number of the sheet you want to use.")
    Set AutomateCompare = .Sheets(shtNum)
End With
End Sub

然后，在调用它时，设置ws1。你仍然需要以某种方式设置ws2。

Sub CommandButton1_Click()

Dim ws As Worksheet, ws1 As Worksheet, ws2 As Worksheet
Set ws1 = AutomateCompare()
Set ws2 = ??
Call Compare2Worksheets(ws1, ws2)
End Sub

更新：

Sub start()

Dim ws As Worksheet, ws1 As Worksheet, ws2 As Worksheet
Set ws1 = AutomateCompare()
Set ws2 = AutomateCompare()
Call Compare2Worksheets(ws1, ws2)
End Sub


Private Function AutomateCompare() As Worksheet
Dim fileBrowse As FileDialog
Dim shtNum As Integer
Set fileBrowse = Application.FileDialog(msoFileDialogOpen)
If fileBrowse.Show = True Then wbPath = fileBrowse.SelectedItems(1)
With Workbooks.Open(wbPath)
    shtNum = InputBox("Enter the number of the sheet you want to use.")
    Set AutomateCompare = .Sheets(shtNum)
End With
End Function


Sub Compare2Worksheets(ws1 As Worksheet, ws2 As Worksheet)
    Dim ws1row As Long, ws2row As Long, ws1col As Integer, ws2col As Integer
    Dim maxrow As Long, maxcol As Integer, colval1 As String, colval2 As String
    Dim report As Workbook, difference As Long
    Dim row As Long, col As Integer
    Set report = Workbooks.Add

    With ws1.UsedRange
        ws1row = .Rows.Count
        ws1col = .Columns.Count
    End With

    With ws2.UsedRange
        ws2row = .Rows.Count
        ws2col = .Columns.Count
    End With

    maxrow = ws1row
    maxcol = ws1col

    If maxrow < ws2row Then maxrow = ws2row
    If maxcol < ws2col Then maxcol = ws2col

    difference = 0

    For col = 1 To maxcol
        For row = 1 To maxrow
            colval1 = ""
            colval2 = ""
            colval1 = ws1.Cells(row, col).Formula
            colval2 = ws2.Cells(row, col).Formula

            If colval1 <> colval2 Then
                difference = difference + 1
                Cells(row, col).Formula = colval1 & "<> " & colval2
                Cells(row, col).Interior.Color = 255
                Cells(row, col).Font.ColorIndex = 2
                Cells(row, col).Font.Bold = True
            End If
        Next row
    Next col

    Columns("a:b").ColumnWidth = 25
    report.Saved = True

    If difference = 0 Then
        report.Close False
    End If
    Set report = Nothing

    MsgBox difference & " cells contain different data! ", vbInformation, "comparing two worksheets"
End Sub

在宏提示后，将ws1和ws2设置为所选文件的工作表

1 个答案: