Создание функции листа Excel - PullRequest
0 голосов
/ 22 января 2020

У меня есть код, который перебирает мою папку для имен файлов, а затем добавляет в словарь.

Если имя файла не существует, то «сделать что-то» (добавить имя файла в лист Excel), иначе «ничего не делать» ".

Однако, когда имя файла существует, часть" ничего не делать "уничтожит имена файлов на листе Excel и оставит лист пустым.

Я знаю, что это из-за этих строк

Dim wks As Worksheet
Set wks = CreateOutputSheet(ActiveWorkbook)

Как изменить код функции или основной код, чтобы при наличии словаря он ничего не делал с данными на листе. Я должен сохранить название листа как «Данные».

Public Dict As Object 
Sub Test1()

Dim oFSO As Object, oFolder As Object, oFile As Object

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

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("C:\Users\Dekstop\")

Dim wks As Worksheet
Set wks = CreateOutputSheet(ActiveWorkbook)

For Each oFile In oFolder.Files
    If Not Dict.Exists(oFSO.GetBaseName(oFile)) Then
    ' Do something 

    Else 
    ' Do nothing 

    End If 
Next oFile
End Sub 


Private Function CreateOutputSheet(ByVal book As Workbook) As Worksheet
    Dim wks As Worksheet
    Application.DisplayAlerts = False
        For Each wks In ActiveWorkbook.Worksheets
    If wks.Name = "Data" Then
        wks.Delete
    End If
    Next wks
    Application.DisplayAlerts = True
    Set wks = book.Worksheets.Add(After:=book.Worksheets(book.Worksheets.count))
    wks.Name = "Data"
    AddColumnHeaders wks
    Set CreateOutputSheet = wks
End Function

Ответы [ 2 ]

1 голос
/ 22 января 2020

Мне кажется, я начинаю понимать, что вы пытаетесь сделать. Мой вердикт состоит в том, что вам не понадобится словарь, если я вас правильно и полностью понимаю. Приведенный ниже код записывает словарь, но ему не нужно определять, что записывать на лист. В конце словарь содержит список имен файлов с объектами файлов как Items, в то время как на листе есть только имена файлов. Вы можете удалить все ссылки на словарь, не затрагивая остальную функциональность кода.

Option Explicit

Public Dict As Scripting.Dictionary         ' prefer early binding

Sub Test1()

    ' early binding works faster and gives you Intellisense access.
    ' use late binding only if your program will run on different versions of Excel
    Dim oFSO As FileSystemObject            ' prefer early binding
    Dim oFolder As Folder
    Dim oFile As File
    Dim Rng As Range
    Dim Fn As String                        ' Base file name
    Dim Ws As Worksheet
    Dim R As Long

    If Dict Is Nothing Then
        Set Dict = CreateObject("Scripting.Dictionary")
    End If

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder("C:\Users\Public\Desktop\")
    Set Ws = CreateOutputSheet(ActiveWorkbook)

    For Each oFile In oFolder.Files
        Fn = oFSO.GetBaseName(oFile)
        With Ws
            Set Rng = .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp))
        End With
        On Error Resume Next
        R = Application.Match(Fn, Rng, 0)
        ' write to worksheet
        If Err Then Rng.Cells(Rng.Cells.Count + 1).Value = Fn

        ' write to dictionary
        If Not Dict.Exists(Fn) Then
            Dict.Add Key:=Fn, Item:=oFile
        End If
    Next oFile
End Sub

Private Function CreateOutputSheet(ByVal Wb As Workbook) As Worksheet

    Dim Ws As Worksheet

    On Error Resume Next
    With Wb.Worksheets
        Set Ws = .Item("Data")
        If Err Then
            Set Ws = .Add(After:=.Item(.Count))
            Ws.Name = "Data"
        End If
    End With

    On Error GoTo 0
'    AddColumnHeaders Ws
    Ws.Cells(1, "A").Value = "FileNames"        ' remove
    Set CreateOutputSheet = Ws
End Function

Часть, которую я до сих пор не понимаю, - как вы найдете файл, который уже есть в списке, так как вы удаляйте список при каждом запуске и начинайте новый. Возможно, ваше намерение состоит в том, чтобы изменить это. Дайте мне знать, если вам нужна помощь, чтобы найти свой код.

0 голосов
/ 22 января 2020

Я просмотрел и прокомментировал ваш код. Вот. Работает просто отлично.

Option Explicit

Public Dict As Scripting.Dictionary         ' prefer early binding

Sub Test1()

    ' early binding works faster and gives you Intellisense access.
    ' use late binding only if your program will run on different versions of Excel
    Dim oFSO As FileSystemObject            ' prefer early binding
    Dim oFolder As Folder
    Dim oFile As File
    Dim Ws As Worksheet

    If Dict Is Nothing Then
        ' Here you are creating a dictionary with one item in it
        ' Key = "Filename", Item = an empty object
        ' no further items are added in this code
        Set Dict = CreateObject("Scripting.Dictionary")
            Dict.Add Key:="filename", Item:=oFile
    End If

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder("C:\Users\Public\Desktop\")
    Set Ws = CreateOutputSheet(ActiveWorkbook)

    For Each oFile In oFolder.Files
        Debug.Print "GetBaseName = "; oFSO.GetBaseName(oFile)
        ' oFSO.GetBaseName(oFile) returns a string holding the name
        ' of the file indicated by the argument
        ' (without path and without extension)
        ' The argument must be a path, i.e. a string, not a file object (!)
        ' If the item wasn't found a nulstring is returned
        ' apparently oFile's default property is its Name.
        ' Therefore your call here actually works.

        Debug.Print Dict.Exists(oFSO.GetBaseName(oFile))
        ' This call returns False for every call because the dictionary is empty.


        If Not Dict.Exists(oFSO.GetBaseName(oFile)) Then
            ' this condition is never met for reasons stated above.
            Debug.Print "Do something"

        End If
    Next oFile
End Sub

Private Function CreateOutputSheet(ByVal Wb As Workbook) As Worksheet

    Dim Ws As Worksheet

    For Each Ws In ActiveWorkbook.Worksheets
        If Ws.Name = "Data" Then
            Application.DisplayAlerts = False
            Ws.Delete
            Application.DisplayAlerts = True
        End If
    Next Ws

    With Wb.Worksheets
        Set Ws = .Add(After:=.Item(.Count))
    End With
    Ws.Name = "Data"

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