Question

假设我在一个文件夹中有20个文件需要每月更新。当前流程是打开每个流程并手动更新。
我正在尝试使用所有事务创建一个“主文件”，然后使用宏将该主文件中的数据提取到每个单独的文件中。每个单独的文件都会在单元格h5中触发，我们可以调用FundA。

在主文件中，列A将是所有基金名称。因此，对于给定月份，FundA可能有买/卖/股息/结束月价格（这个价格总是在那里）。我有完整的代码只是为了显示我的初始步骤，但我真的需要帮助 Selection.FormulaArray part。

目标：通过计算触发器（单个文件的单元格H5中的基金名称）在ClientMonthlyUpdate列A：A中的次数，让各个基金文件搜索事务，然后在每次出现时给出ClientMonthlyUpdate列B：G中的内容。本质上是一个多次出现的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 ...”我想要做的是计算Word“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

VBA编码列中的多次出现以及相应的结果

1 个答案: