VBA列内の複数のオカレンスのコーディングと対応する結果

Question

毎月更新する必要があるフォルダに20個のファイルがあるとします。現在のプロセスは、それぞれを開いて手動で更新することです。
私はすべてのトランザクションで1つの "マスターファイル"を作成しようとしていて、そのマスターファイルのデータを個々のファイルにプルするマクロを使用しています。個々のファイルは、FundAを呼び出すことができるセルh5にトリガーを持ちます。

マスターファイルでは、列Aはすべてのファンド名になります。だから1ヶ月間、FundAは買い/売り/配当/月末の価格を持つことができます（これは常にそこにあります）。最初の手順を示すだけのコードがありますが、実際には Selection.FormulaArrayパーツのヘルプが必要です。

目標： は何回トリガー（個々のファイルのセルH5におけるファンド名）をカウントすることにより、取引のための個々のファンドのファイル検索をお持ちのClientMonthlyUpdate列Aである：Gごとに：その後、ClientMonthlyUpdate列Bにあるものを私に与えて発生。本質的に複数の出現を伴うVlookup。一度それがすべての出現を持っていると、私は数式製品を ""持って、すべてが完了したら値を貼り付けます。

Sub MonthlyUpdate() 

Dim MyFolder As String 
Path collected from the folder picker dialog 
Dim MyFile As String 
Filename obtained by DIR function 
Dim wbk As Workbook 
Used to loop through each workbook 
Dim myExtension As String 

myExtension = "*.xls" 
Target File Extension (must include wildcard "*") 
On Error Resume Next 

Application.ScreenUpdating = False 

Opens the folder picker dialog to allow user selection 

With Application.FileDialog(msoFileDialogFolderPicker) 

.Title = "Please select a folder" 

.Show 

.AllowMultiSelect = False 

If .SelectedItems.Count = 0 Then 
    'If no folder is selected, abort 

MsgBox "You did not select a folder" 

    Exit Sub 

End If 

MyFolder = .SelectedItems(1) & "\" 
'assign selected folder to MyFolder 


myExtension = "*.xls" 
'Target File Extension (must include wildcard "*") 
End With 

MyFile = Dir(MyFolder) 

'DIR gets the first file of the folder 

'Loop through all files in a folder until DIR cannot find anymore 

Do While MyFile <> "" 

'Opens the file and assigns to the wbk variable for future use 

Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile) 

'Replace the line below with the statements you would want your macro to perform 

Sheets(1).Select 
' opens up first sheet 
range("A12").Select 
'always the first populated cell in all workbooks, easy start 
Selection.End(xlDown).Offset(1, 0).Select 
'go down to last months update plus a new blank cell to insert current months activity 

'this is where i get lost. this gives me runtime error 1004. There are named ranges transactions,and Fund. 
Selection.FormulaArray = _ 
     **"=IF(OR(ISERROR(INDEX(ClientMonthlyUpdate.xlsx!Transactions,SMALL(IF(ClientMonthlyUpdate.xlsx!Fund=R1C8,ROW(Date)),ROW(R[-54])),COLUMN(R[-1]C)+1)),INDEX(ClientMonthlyUpdate.xlsx!Transactions,SMALL(IF(ClientMonthlyUpdate.xlsx!Fund=R1C8,ROW(Date)),ROW(R[-54])),COLUMN(R[-1]C)+1)=0),"""",INDEX(ClientMonthlyUpdate.xlsx!Transactions,SMALL(IF(ClientMonthlyUpdate.xlsx!Fund=R" & _ 
    "Date)),ROW(R1:R1])),COLUMN(R[-1]C)+1))"** 


range("A12").Select 
Selection.End(xlDown).Select 
'select formula just created 
Selection.Copy 
range(Selection.Offset(0, 1), Selection.Offset(0, 5)).Select 
'copy over through column F 
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _ 
    SkipBlanks:=False, Transpose:=False 

MyFile = Dir 

'DIR gets the next file in the folder 

Loop 

Application.ScreenUpdating = True 

End Sub 

Answer 1

多くのグーグルがアドバイスを探した後、以下のコードでコーディングの質問に答えることができました。今私の問題は、私はデバッグ時に夢のように実行するコードを実行するときですが、私はちょうど50/50ヒット率ですプログラムを実行するときです。行は各ファイルでハイライト表示されますが、貼り付けたり貼り付けたりしないことがあります。私の考えは、私のコードは記述が不十分で、効率の調整が必要であるということです。私は最悪の行が "For Each Cell ..."だと思っています。私はそこで何をしようとしているのですか？Word1の「Artisan」がTable1の列Aに現れる回数を数えます。今は100 +以上の列のすべてのセルを検索しています。どんな助けでも大歓迎です。

Sub MonthlyUpdate() 

Dim MyFolder As String 
    'Path collected from the folder picker dialog 
Dim MyFile As String 
    'Filename obtained by DIR function 
Dim wbk As Workbook 
    'Used to loop through each workbook 
Dim myExtension As String 

myExtension = "*.xls" 
    'Target File Extension (must include wildcard "*") 
On Error Resume Next 

'Opens the folder picker dialog to allow user selection 

With Application.FileDialog(msoFileDialogFolderPicker) 

    .Title = "Please select a folder" 

    .Show 

    .AllowMultiSelect = False 

    If .SelectedItems.Count = 0 Then 
     'If no folder is selected, abort 

MsgBox "You did not select a folder" 

     Exit Sub 

    End If 

MyFolder = .SelectedItems(1) & "\" 
    'assign selected folder to MyFolder 

    myExtension = "*.xls" 
    'Target File Extension (must include wildcard "*") 
End With 

MyFile = Dir(MyFolder) 

    'DIR gets the first file of the folder 

    'Loop through all files in a folder until DIR cannot find anymore 

Do While MyFile <> "" 

    'Opens the file and assigns to the wbk variable for future use 

    Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile) 

     Dim MonthlyUpdate As Workbook 
     Set MonthlyUpdate = Workbooks("CLientMonthlyUpdate") 
     'give master file a name to reference later 

     Dim MasterWS As Worksheet 
     Set MasterWS = MonthlyUpdate.Worksheets("Transactions") 
     'give master file sheet a name to reference later 

     Dim Table As ListObject 
     Set Table = MasterWS.ListObjects("Table1") 
     'give transactions table a name to reference later 

     Dim trows As Long 
     trows = Table.DataBodyRange.Rows.Count 
     'Count how many rows are in the master file sheet table 

     Sheets(1).Select 
     ' opens up first sheet 
     range("A12").Select 
     'always the first populated cell in all workbooks, easy start 
     Selection.End(xlDown).Offset(1, 0).Select 
     'go down to last months update plus a new blank cell to insert current months activity 

     Dim Trigger As range 
     Set Trigger = range("I1") 
     'If excel sheet does not have Macro type in then the rest will not run. Three different types of excel files will be in the folder 

      If Trigger = "Macro" Then 

       Dim CurrentBook As Workbook 
       Set CurrentBook = ActiveWorkbook 
       'most recently opened file is now the active workbook 

       Dim FundName As range 
       Set FundName = range("H1") 
       'Fund name is in H1 

        For Each Cell In MasterWS.range("A1" & ":" & "A" & trows) 'search ALL of column A in transaction for the Fund Name 
         If Cell = FundName Then 
          matchrow = Cell.Row 
          MonthlyUpdate.Activate 'open up master workbook with transactions 
          range("B" & matchrow & ":" & "G" & matchrow).Select 'copy row of first occurrence 
          Selection.Copy 
          CurrentBook.Activate 'open up most recent individual file that we are working with 
          range("A12").Select 
          Selection.End(xlDown).Offset(1, 0).Select 'go down to last row in column A and down one cell 
          range(Selection.Offset(0, 0), Selection.Offset(0, 5)).Select 'paste results from master workbook into the to column F 
          Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _ 
          SkipBlanks:=False, Transpose:=False 
         End If 

        Next 

       Worksheets(ActiveSheet.Index + 1).Select 
       range("A1000").Select 
       Selection.End(xlUp).EntireRow.Select 
       Selection.AutoFill Destination:=range(Selection, Selection.Offset(1, 0)) 
       Worksheets(ActiveSheet.Index + 1).Select 
       range("A1000").Select 
       Selection.End(xlUp).EntireRow.Select 
       Selection.AutoFill Destination:=range(Selection, Selection.Offset(1, 0)) 
      End If 

      If Trigger = "Combined" Then 

       Worksheets(ActiveSheet.Index).Select 
       range("A1000").Select 
       Selection.End(xlUp).EntireRow.Select 
       Selection.AutoFill Destination:=range(Selection, Selection.Offset(1, 0)) 
       Worksheets(ActiveSheet.Index + 1).Select 
       range("A1000").Select 
       Selection.End(xlUp).EntireRow.Select 
       Selection.AutoFill Destination:=range(Selection, Selection.Offset(1, 0)) 

      End If 

MyFile = Dir 

    'DIR gets the next file in the folder 

Loop 

End Sub