VBA“激活加循环”冲突

Question

我遇到的这个问题包含三个文件：
“本地销售”、“全球销售”和“模板”。
销售文件的第 1 列和第 2 列是相同的，3 列各有不同的信息。所有这些数据都必须复制到“模板”中的工作表中。 第 1 列和第 2 列必须复制到相同的位置（第 1 列和第 2 列），第 3 列必须是本地销售文件中的第 3 列，第 4 列必须是全球销售文件中的第 3 列。跟我到现在？我希望如此...

这个例程第一次运行时一切顺利。它迭代第一个源文件中的所有列并将它们粘贴到模板上。但是当 fileNumber = 2 时（当它应该对第二个源文件做同样的事情时），标记的行声称“需要一个对象”。 这让我发疯了，因为我看不出它第一次起作用但第二次不起作用的原因！

我知道使用“激活”之类的命令是错误的，但这是我第一次使用 VBA，这是我看到的第一件事。请原谅它:)

Sub OpenFiles(ByVal fileNumber)

    If fileNumber = 1 Then
        Dim localFile As Workbook
        Set localFile = Application.Workbooks.Open("local sales.xls") ' here the path of "local sales.xls"
        Dim templateFile As Workbook
        Set templateFile = Application.Workbooks.Open("Template.xls") ' here the path of "Template.xls"
        localFile.Sheets("Sheet1").Activate
    Else
        Dim globalFile As Workbook
        Set globalFile = Application.Workbooks.Open("global sales.xls") ' here the path of "global sales.xls"
        globalFile.Sheets("Sheet1").Activate
    End If

    Dim lastColumnOnSource, lastRow, lastColumnOnDestiny As Long
    Dim textLastRow, textCol, areaToSelect, areaToPaste As String

    lastColumnOnSource = (ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column)
    lastRow = ActiveSheet.UsedRange.Rows.Count
    textLastRow = CStr(lastRow)

    For currentColumnOnSource = 1 To lastColumnOnSource
        If fileNumber = 1 Then
            localFile.Sheets("Sheet1").Activate
        Else
            globalFile.Sheets("Sheet1").Activate
        End If

        columnAsLetter = ColumnLetter(currentColumnOnSource)
        Let areaToSelect = columnAsLetter & "1:" & columnAsLetter & textLastRow
        Range(areaToSelect).Select
        Selection.Copy

        ' Moving to the template, to paste the data
        templateFile.Sheets("Data").Activate ' HERE IS THE ERROR
        lastColumnOnDestiny = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
        Dim cell1, cell2 As String
        Dim cell2AsRange As Range
        For currentColumnOnDestiny = 1 To lastColumnOnDestiny
            ' I take the first cell ("header") on the column and compare it until it's header
            ' matches the header on the column that is being copied and paste it there
            Let cell1 = columnAsLetter & "1"
            Let cell2 = ColumnLetter(currentColumnOnSource) & "1"
            If Range(cell1).Value = Range(cell2).Value Then
                ' select the column that cell 2 belongs on, to paste in it
                Let areaToPaste = cell1 & ":" & cell2
                Range(areaToPaste).Select
                Range(areaToPaste).PasteSpecial
                Exit For
            End If
        Next
    Next

    Application.CutCopyMode = False
    'Application.ActiveWorkbook.Save

End Sub

Answer 1

正如 Rich Holton 所指出的，除非 fileNumber 为 1，否则您不会为 templateFile 赋值。因此，当您到达语句 templateFile.Sheets("Data").Activate 时，它不知道 templateFile 是什么。

最简单的更改就是在If 语句中添加TemplateFile 的赋值。

Dim templateFile As Workbook
If fileNumber = 1 Then
    Dim localFile As Workbook
    Set localFile = Application.Workbooks.Open("local sales.xls") ' here the path of "local sales.xls"
    Set templateFile = Application.Workbooks.Open("Template.xls") ' here the path of "Template.xls"
    localFile.Sheets("Sheet1").Activate
Else
    Dim globalFile As Workbook
    Set globalFile = Application.Workbooks.Open("global sales.xls") ' here the path of "global sales.xls"
    globalFile.Sheets("Sheet1").Activate
    Set templateFile = Application.Workbooks("Template.xls") ' here the path of "Template.xls"
End If

---

这将解决您当前的问题，但我怀疑当您到达执行复制/粘贴的代码部分时您会遇到问题。据我所知，您的第二个文件的详细信息将覆盖您从第一个文件中获得的内容，但是您的问题不够清楚，我无法为您修复该代码。 （您的问题仅涉及文件 1 中的第 3 列到第 3 列，以及文件 2 中的第 3 列到第 4 列 - 但您的代码看起来正在尝试处理比这更多的列。）

Answer 2

您可以使用 ADODB 对 Local Sales 和 Global Sales 工作簿进行 SQL 查询，然后将结果保存到 Template 工作簿中。

典型的 INNER JOIN 查询是：

SELECT
A.Field1 AS F1, A.Field2 AS F2, B.Field2 AS F3
FROM Table1 AS A
INNER JOIN Table2 AS B

如果您想合并来自两个来源的数据，即使记录的某些字段为空，那么您可以尝试 FULL JOIN 查询。 Jet SQL 不支持 FULL JOIN，所以有一个变通方法，将左连接和右连接联合起来（注意非不同源会丢失重复项）：

SELECT
A.Field1 AS F1, A.Field2 AS F2, B.Field2 AS F3
FROM Table1 AS A
LEFT JOIN Table2 AS B
ON A.Field1 = B.Field1
UNION
SELECT
B.Field1 AS F1, A.Field2 AS F2, B.Field2 AS F3
FROM Table1 AS A
RIGHT JOIN Table2 AS B
ON A.Field1 = B.Field1

下面的示例代码显示了如何完成 INNER JOIN 查询：

Option Explicit

Sub JoinQuery()

    Dim sGlobalDataPath As String
    Dim sLocalDataPath As String
    Dim sTemplatePath As String
    Dim sGlobalDataSheet As String
    Dim sLocalDataSheet As String
    Dim sTemplateSheet As String
    Dim sProvider As String
    Dim sType As String
    Dim sGlobalData As String
    Dim sLocalData As String
    Dim sConnection As String
    Dim oTargetWorkbook As Workbook
    Dim sQuery As String
    Dim oConnection As Object
    Dim oRecordset As Object

    ' Put your paths and sheet names below
    ' Set path to Global Sales source file
    sGlobalDataPath = ThisWorkbook.Path & "\Global Sales.xlsx"
    sGlobalDataSheet = "Sheet1"
    ' Set path to Local Sales source file
    sLocalDataPath = ThisWorkbook.Path & "\Local Sales.xlsx"
    sLocalDataSheet = "Sheet1"
    ' Set path to Local Sales source file
    sTemplatePath = ThisWorkbook.Path & "\Template.xlsx"
    sTemplateSheet = "Sheet1"

    ' Create connection string to open ADODB.Connection
    GetConnOpts ThisWorkbook.FullName, sProvider, sType
    sConnection = _
        sProvider & _
        "Data Source='" & ThisWorkbook.FullName & "';" & _
        "Mode=Read;" & _
        "Extended Properties=""" & sType & """;"
    ' Open connection
    Set oConnection = CreateObject("ADODB.Connection")
    oConnection.Open sConnection

    ' Create connection strings for source files
    GetConnOpts sGlobalDataPath, sProvider, sType
    sGlobalData = "[" & sGlobalDataSheet & "$] IN '" & sGlobalDataPath & "' " & _
        "[" & sType & sProvider & "Mode=Read;Extended Properties=""HDR=YES;""] "
    GetConnOpts sLocalDataPath, sProvider, sType
    sLocalData = "[" & sLocalDataSheet & "$] IN '" & sLocalDataPath & "' " & _
        "[" & sType & sProvider & "Mode=Read;Extended Properties=""HDR=YES;""] "

    ' Create INNER JOIN query string
    sQuery = _
        "SELECT " & _
        "G.CustomerName, G.ContactName, G.Qty AS GlobalQty, L.Qty AS LocalQty " & _
        "FROM " & _
        "(SELECT * FROM " & sGlobalData & ") AS G " & _
        "INNER JOIN " & _
        "(SELECT * FROM " & sLocalData & ") AS L " & _
        "ON G.ContactName = L.ContactName AND G.CustomerName = L.CustomerName;"

    ' Execute query
    Set oRecordset = oConnection.Execute(sQuery)
    ' Open target workbook for output
    Set oTargetWorkbook = Application.Workbooks.Open(sTemplatePath)
    ' Output resulting recordset
    RecordsetToWorksheet oTargetWorkbook.Sheets(sTemplateSheet), oRecordset
    ' Save and close target workbook
    oTargetWorkbook.Save
    oTargetWorkbook.Close
    ' Close connection
    oConnection.Close

End Sub

Sub GetConnOpts(sFile As String, sProvider As String, sType As String)

    Select Case LCase(Mid(sFile, InStrRev(sFile, ".")))
        Case ".xls"
            sProvider = "Provider=Microsoft.Jet.OLEDB.4.0;"
            sType = "Excel 8.0;"
        Case ".xlsm"
            sProvider = "Provider=Microsoft.ACE.OLEDB.12.0;"
            sType = "Excel 12.0 Macro;"
        Case ".xlsx", ".xlsb"
            sProvider = "Provider=Microsoft.ACE.OLEDB.12.0;"
            sType = "Excel 12.0;"
        Case Else
            sProvider = ""
            sType = ""
    End Select

End Sub

Sub RecordsetToWorksheet(oSheet As Worksheet, oRecordset As Object)

    Dim i As Long

    With oSheet
        .Cells.Delete
        For i = 1 To oRecordset.Fields.Count
            .Cells(1, i).Value = oRecordset.Fields(i - 1).Name
        Next
        .Cells(2, 1).CopyFromRecordset oRecordset
        .Cells.Columns.AutoFit
    End With

End Sub

要进行 FULL JOIN，请将字符串 sQuery = ... 替换为以下代码：

    ' Create simplified FULL JOIN query string
    sQuery = _
        "SELECT " & _
        "G.CustomerName, G.ContactName, G.Qty AS GlobalQty, L.Qty AS LocalQty " & _
        "FROM " & _
        "(SELECT * FROM " & sGlobalData & ") AS G " & _
        "LEFT JOIN " & _
        "(SELECT * FROM " & sLocalData & ") AS L " & _
        "ON G.CustomerName = L.CustomerName AND G.ContactName = L.ContactName " & _
        "UNION " & _
        "SELECT " & _
        "L.CustomerName, L.ContactName, G.Qty AS GlobalQty, L.Qty AS LocalQty " & _
        "FROM " & _
        "(SELECT * FROM " & sGlobalData & ") AS G " & _
        "RIGHT JOIN " & _
        "(SELECT * FROM " & sLocalData & ") AS L " & _
        "ON G.CustomerName = L.CustomerName AND G.ContactName = L.ContactName"

我使用示例源文件Global Sales.xlsx、Local Sales.xlsx 和输出文件Template.xlsx 测试了代码。所有这些文件都位于与上述代码的.xlsm 文件相同的文件夹中。 Global Sales.xlsx的内容是：

和Local Sales.xlsx:

INNER JOIN 的输出 Template.xlsx 是：

FULL JOIN 的输出是：

您可以使用.xlsb、.xlsm、.xls 以及.xlsx。