VBA Проблемы с запуском двух функций

Question

Я делаю инструмент VBA, где я извлекаю имена всех файлов в папке в Excel (назовите это вывод A).После этого я выполняю некоторую обработку имен файлов, чтобы извлечь их часть (назовите это output B).(Мой инструмент работает до сих пор). После этого я хочу извлечь только уникальные значения из вывода B. На этом шаге я столкнулся с проблемой.

Код для получения вывода A:

Sub GetFileNames()

Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$

InitialFoldr$ = "G:\" '<<< Startup folder to begin searching from

With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = Application.DefaultFilePath & "\"
    .Title = "Please select a folder to list Files from"
    .InitialFileName = InitialFoldr$
    .Show
    Worksheets("Sheet1").Activate
    Worksheets("Sheet1").Range("C11").Activate

    If .SelectedItems.Count <> 0 Then
        xDirect$ = .SelectedItems(1) & "\"
        xFname$ = Dir(xDirect$, 7)
        Do While xFname$ <> ""
            ActiveCell.Offset(xRow) = xFname$
            xRow = xRow + 1
            xFname$ = Dir
        Loop
    End If
End With
getunique
End Sub

Код для генерации выхода B:

Sub getunique()
Range("F11:F70").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("C3"), Unique:=True
End Sub

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

Я создал два отдельных макроса.Когда я запускаю второй макрос, сгенерированный список (вывод A) автоматически очищается.

Может ли кто-нибудь помочь?

Спасибо

Answer 1

Добро пожаловать в StackOverflow.

Ваша вторая функция относится к ActiveSheet (в данном случае «Лист1»).В идеале вы всегда должны полностью определять свои диапазоны, то есть: ThisWorkbook.Worksheets("Sheet2").Range("C3"), хотя я лично предпочитаю присваивать переменные:

Dim WB as Workbook : Set WB = ThisWorkbook
Dim WS as Worksheet : Set WS = WB.Sheets("Sheet1")

Тогда вы можете легко использовать их позже:

With WS
    .Range("F11:F70").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("D3"), Unique:=True
End With

В любом случае, тот факт, что вы пытаетесь записать в один и тот же столбец, не помогает ...

Попробуйте выполнить приведенное ниже, если у вас есть "Sheet2":

Sub getunique()
    Worksheets("Sheet1").Range("F11:F70").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets("Sheet2").Range("C3"), Unique:=True
End

В качестве альтернативы, измените CopyToRange:=Range("C3") на другой столбец, который все еще должен работать.

EDIT Ошибка, которую вы получаете, состоит в том, что у вас нет ничего в Range("F11:F70") ... измените расширенный фильтруказать диапазон, в котором вы собираете имена файлов Range("C11:C70").