Использование массива для переноса имен файлов в рабочую книгу с несколькими листами - PullRequest
1 голос
/ 08 июля 2019
    Public Sub GetSOPFiles()
    '   Set folder path
        Const FolderPath As String = "C:\Users\test\Desktop\SOP Audit Excel Prototype"

        Const FileExt As String = "docx"

        Dim Result As Variant
        Dim i As Integer
        Dim MyFile As Object
        Dim MyFSO As Object
        Dim MyFolder As Object
        Dim MyFiles As Object
        Dim dept As Variant
        Dim deptCodes() As Variant

        Set MyFSO = CreateObject("Scripting.FileSystemObject")
        Set MyFolder = MyFSO.GetFolder(FolderPath)
        Set MyFiles = MyFolder.Files

    '   Research built-in Result function in VBA
        ReDim Result(1 To MyFiles.Count)

        Dim vData As Variant
        Dim sTemp As Variant

    '   Use a For loop to loop through the total number of sheets
        For i = 1 To 12
    '       Setup Select to determine dept values
            Select Case i

                Case 1
                    deptCodes = Array("PNT", "VLG", "SAW")

                Case 2
                    deptCodes = Array("CRT", "AST", "SHP", "SAW")

                Case 3
                    deptCodes = Array("CRT", "STW", "CHL", "ALG", "ALW", "ALF", "RTE", "AFB", "SAW")

                Case 4
                    deptCodes = Array("SCR", "THR", "WSH", "GLW", "PTR", "SAW")

                Case 5
                    deptCodes = Array("PLB", "SAW")

                Case 6
                    deptCodes = Array("DES")

                Case 7
                    deptCodes = Array("AMS")

                Case 8
                    deptCodes = Array("EST")

                Case 9
                    deptCodes = Array("PCT")

                Case 10
                    deptCodes = Array("PUR", "INV")

                Case 11
                    deptCodes = Array("SAF")

                Case 12
                    deptCodes = Array("GEN")
            End Select

'       Loop through files in directory
        j = 0
        For Each MyFile In MyFiles
'           Limit files by file extension
            If InStr(1, MyFile.Name, FileExt) <> 0 Then
'               Explode file name into array and only pull files with defined dept codes
                Dim toSplitFileName As Variant
                toSplitFileName = Split(MyFile.Name, "-")
                For Each dept In deptCodes
                    If dept = toSplitFileName(3) Then
                        ReDim Preserve Result(0 To j)
                        Result(j) = MyFile.Name
                        j = j + 1
                    End If
                Next dept
            End If
        Next MyFile
'       Send array to worksheet
        Range("A1:A20").Value = Application.WorksheetFunction.Transpose(Result)
    Next

    End Sub

Хорошо, вы были правы насчет вне диапазона. Я отредактировал свой код и опубликовал его.

То, что я пытаюсь сделать здесь, это извлечь имена файлов, отсортировать их после анализа их имени файла (используя SELECT для определения различных значений, которые я ищу), а затем перенести эти имена файлов в виде массива на каждый соответствующий лист в Учебное пособие.

У меня была рабочая (в некоторой степени) функция, и она работала очень медленно, поэтому после получения некоторого совета здесь отправлять результаты в массив, а затем использовать VBA для передачи непосредственно на рабочие листы; это то, что я имею до сих пор.

Я пытаюсь выяснить, как я могу отправить данные на каждый лист сейчас ... У меня это работает на одном листе. Скажем, он просматривает и находит все файлы для SELECT Case 1, он отправляет все эти имена файлов в столбец A на листе 1. То же самое для Case 2 и т. Д.

В данный момент это просто заполнение всех ячеек в определенном диапазоне одним именем файла снова и снова.

Вот так ...

enter image description here

Спасибо всем за переполнение стека! После 3 покупок книг и нескольких постов, я чувствую, что начинаю продвигаться вперед в VBA. Тем не менее, есть еще чему поучиться.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...