Excel VBA словарь не зациклен - PullRequest
0 голосов
/ 20 января 2020

Before

What i want

У меня есть этот код, который должен перебирать мою папку и добавлять имена файлов в словарь, однако после добавления моего кода извлечения для l oop, будут извлечены только данные из последнего файла в папке, потому что каждый раз, когда он собирает данные из следующего файла, он перезаписывает строку и столбец "A2: М2 "и не продолжайте прибавлять.

ОБНОВЛЕНО

Public Dict As Object
Sub EEE()

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False

Dim oFSO As Object, oFolder As Object, ofile As Object

Set oFSO = CreateObject("Scripting.fileSystemObject")
Set oFolder = oFSO.GetFolder("C:\Users\Desktop\file\")

If Dict Is Nothing Then
Set Dict = CreateObject("Scripting.Dictionary")
    Dict.Add Key:="filename", Item:=ofile
End If

For Each ofile In oFolder.Files
    If Not Dict.Exists(oFSO.GetBaseName(ofile)) Then

    Dim basePath As Variant
    basePath = "C:\Users\Desktop\file\"

             Dim baseFolder As Scripting.Folder
        With New Scripting.FileSystemObject
            Set baseFolder = .GetFolder(basePath)
        End With


            Dim file As Scripting.file
            For Each file In baseFolder.Files

            Dim a As Range

        Dim wkbData As Workbook
            Set wkbData = Workbooks.Open(file.path)

        Dim wksData As Worksheet
            ActiveSheet.Name = "Book1"
            Set wksData = wkbData.Worksheets("Book1") ' -> Assume this file has only 1 worksheet

            Dim LastRow As Long
                LastRow = wks.Range("A" & wks.Rows.count).End(xlUp).row + 1

            wks.Cells(LastRow, 6).value = file.Name

        Set a = wksData.Columns("A:A").Find("  test1234         : ", LookIn:=xlValues)
        If Not a Is Nothing Then
        wks.Cells(LastRow, 1) = Split(a.value, ":")(1)
        End If

                wkbData.Close False

                Range("A:M").EntireColumn.AutoFit
                Range("A1").AutoFilter

        Debug.Print "A: " & oFSO.GetBaseName(ofile)
        Dict.Add oFSO.GetBaseName(ofile), 1
                Next file

    Else
        'skip
        Debug.Print "E: " & oFSO.GetBaseName(ofile)

    End If

Next ofile

        Application.ScreenUpdating = True
        Application.EnableEvents = True
        Application.DisplayStatusBar = True

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