VBA「プラスループをアクティブにする」コンフリクト

Question

私が持っているこの問題には、
「ローカルセールス」、「グローバルセールス」および「テンプレート」という3つのファイルがあります。
セールスファイルのカラム1とカラム2は同じですが、3はそれぞれ異なる情報を持っています。そのデータはすべて「テンプレート」のシートにコピーされなければなりません。 カラム1とカラム2は同じ場所にコピーする必要があります（カラム1 & 2）.3番目のカラムはローカルセールスファイルの3番目のカラムで、4番目のカラムはグローバルセールス3番目のカラムでなければなりません。これまでの私と？私はそう望んでいます...

このルーチンが初めて実行されたとき、すべてがうまく行きました。これは、最初のソースファイル内のすべての列を反復し、テンプレートに貼り付けます。しかし、fileNumber = 2（2番目のソースファイルと同じことが必要な場合）の場合、マークされた行は「オブジェクトが必要です」と主張します。 これは私が最初に動作する理由を見ることができないので、ナットを運転していますが、2回目ではありません！

「アクティブ化」などのコマンドを使用するのは間違っていることがわかりますが、VBAを使用するのは初めてです。これが最初に見たものです。リッチホルトンが指摘したようにfileNumberあなたは声明templateFile.Sheets("Data").Activateに得るとき、それは何templateFile知らない、したがって1でない限り、それと慈悲てください:)

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に値を代入されていませんです。

あなたの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 

---

これはあなたの当面の問題を解決しますが、私は、あなたがコピー/貼り付けを行っているコードの一部を取得するときあなたが問題を抱えているだろうと思われます。私の知る限り、第2のファイルの詳細は、最初のファイルから取得したものを上書きしますが、そのコードを修正するための十分な質問がありません。 （あなたの質問は、ファイル1の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クエリを登録しようしようとします。ジェット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は、次のコードを持つ文字列sQuery = ...置き換えるJOINを作るために：私は、サンプル・ソース・ファイル012を使用してコードをテストした

' 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" 

を,Local Sales.xlsxおよび出力ファイルTemplate.xlsx。これらのファイルはすべて、上記のコードを持つ.xlsmファイルと同じフォルダにあります。 Global Sales.xlsxの内容は次のとおりです。

とLocal Sales.xlsx：

そしてFULLための出力は、JOIN：INNERため

出力Template.xlsx JOINをありますis：

あなたは.xlsb、.xlsm、.xlsなど.xlsxを使用することができます。