VBA「Activate plus loop」衝突

Question

我得到的這個問題有三個文件：
「本地銷售」，「全球銷售」和「模板」。
銷售文件的第1列和第2列是相同的，第3列中的每個都有不同的信息。所有這些數據都必須複製到「模板」中的工作表中。 必須將第1列和第2列複製到相同的地方（第1列），第3列必須是本地銷售文件的第3列，第4列必須是全球銷售文件第3列。和我一起到目前爲止？我希望如此...

這個例程第一次運行時，一切都很好。它迭代第一個源文件中的所有列，並將它們粘貼到模板上。但是，當fileNumber = 2（當它應該對第二個源文件執行相同操作時），標記行聲稱「需要一個對象」。 這讓我瘋狂，因爲我無法看到它第一次運作的原因，但不是第二次！

我知道使用諸如「activate」之類的命令是錯誤的，但是這是我第一次使用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

豐富霍爾頓指出的那樣，你是不是值分配給templateFile除非fileNumber爲1。因此，當你到了聲明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到第4列的第3列 - 但是你的代碼看起來像是在試圖處理比這更多的列。）

Answer 2

你可以使用ADODB將SQL查詢設置爲Local Sales和Global Sales工作簿，然後將結果保存到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查詢從兩個數據源的數據結合起來。噴氣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 

充分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：

輸出Template.xlsx的INNER JOIN是：

和輸出的FULL JOIN是：

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