Excel VBA: как петлять через книги в той же папке, используя данный код?

( Предыдущая статья )

Мне нужно создать макрос, который проходит через файлы, находящиеся в одной папке, и запускает код, который я привел ниже. Однако все файлы структурированы одинаково, имеют разные данные. Код помогает мне перейти к указанному файлу назначения и подсчитывает количество «ДА» в столбце. Затем он выводит его в CountResults.xlsm (основная книга). У меня есть следующий код с помощью Zac :

Private Sub CommandButton1_Click() Dim oWBWithColumn As Workbook: Set oWBWithColumn = Application.Workbooks.Open("C:\Users\khanr1\Desktop\CodeUpdateTest\Test01.xlsx") Dim oWS As Worksheet: Set oWS = oWBWithColumn.Worksheets("Sheet2") ThisWorkbook.Worksheets("Sheet1").Range("B2").Value = Application.WorksheetFunction.CountIf(oWS.Range("B:B"), "YES") oWBWithColumn.Close False Set oWS = Nothing Set oWBWithColumn = Nothing End Sub 

Вот что выглядит CountResults.xlsm (Master Workbook):

CountResults.xlsm

И это пример того, как выглядит Test01.xlsx:

Test01.xlsx

Следует отметить, что есть 10 тестовых файлов (Test01, Test02 …), но код должен иметь возможность обновлять новые новые тестовые файлы (например, Test11, Test12 …). У меня возникла идея включить столбец «Файлы» на первом изображении, чтобы вытащить имена файлов и закодировать их.

Самое простое – преобразовать ваш код в функцию.

 Private Sub CommandButton1_Click() Dim r As Range With Worksheets("Sheet1") For Each r In .Range("A2", .Range("A" & .Rows.Count).End(xlUp)) r.Offset(0, 1).Value = getYesCount(r.Value) Next End With End Sub Function getYesCount(WorkBookName As String) As Long Const FolderPath As String = "C:\Users\khanr1\Desktop\CodeUpdateTest\" If Len(Dir(FolderPath & WorkBookName)) Then With Workbooks.Open(FolderPath & WorkBookName) With .Worksheets("Sheet2") getYesCount = Application.CountIf(.Range("B:B"), "YES") End With .Close False End With Else Debug.Print FolderPath & WorkBookName; ": Not Found" End If End Function 

Самый простой способ сделать это – использовать файл filesystemobject для прокрутки всех файлов в папке и найти те, где имя файла похоже на предопределенную маску (в вашем случае «Test * .xslx»). Обратите внимание, что он также проходит через подпапки в указанной папке. Если это не требуется, опустите первый для каждого цикла:

 Dim fso As Object 'FileSystemObject Dim fldStart As Object 'Folder Dim fld As Object 'Folder Dim fl As Object 'File Dim oWBWithColumn As Workbook Dim oWbMaster as workbook Dim oWsSource as worksheet Dim oWsTarget as worksheet Dim Mask As String Dim k as long k=2 Set oWbMaster = ActiveWorkbook Set oWsTarget = oWbMaster.Sheets("Sheet1") Set fso = CreateObject("scripting.FileSystemObject") Set fldStart = fso.GetFolder("C:\Users\khanr1\Desktop\CodeUpdateTest\") Mask = "Test*" & ".xlsx" For Each fld In fldStart.Subfolders For Each fl In fld.Files If fl.Name Like Mask Then Set oWBWithColumn = Application.Workbooks.Open(Filename:=fld.Path & "\" & fl.Name, ReadOnly:=True) Set oWsSource = oWBWithColumn.Worksheets("Sheet2") oWsTarget.Range("B"& k).Value = Application.WorksheetFunction.CountIf(oWsSource.Range("B:B"), "YES") oWBWithColumn.Close SaveChanges:=False k = k+1 End If Next Next 

Если этот ответ поможет, отметьте как принято. Также обратите внимание, что ваш исходный код заменит значение ячейки B2 в главной таблице на каждой итерации цикла, поэтому я добавил переменную k чтобы изменить целевую ячейку после каждой итерации

PS

Вы можете сгенерировать список файлов вместе с подсчетами дат из папки в одно и то же время, просто добавьте эту строку в код перед закрытием файла:

 oWsTarget.Range("A"& k).Value= fl.Name 
  • excel vba: суммирование значения столбца до последнего столбца
  • Создание цикла с данными из других листов
  • Форматирование исходного источника
  • Цикл через файлы XLSM SSIS 2012
  • Excel. Поиск соседних ячеек, которые равны определенному значению
  • Перебирайте каждый WS в каждом открытом WB и снимайте защиту
  • Worksheet_change, похоже, не срабатывает
  • Копирование текста с листа на другой в зависимости от того,
  • переменная объекта или с переменной блока не установлена ​​91 VBA
  • Excel VBA для очистки ряда строк на нескольких листах на основе последней используемой строки для этого листа
  • Активная рабочая книга случайно изменена после выполнения макроса
  • Interesting Posts

    springmvc с использованием шаблона excel для экспорта

    Объединение файлов CSV в XLSX с вкладками

    Автоматически сопоставлять Excel XmlMap на листе в VBA без знания схемы XPaths

    Используйте значение даты в Excel для применения условного форматирования с помощью VBA

    Хранить строки MATLAB, содержащиеся в массиве ячеек в Excel-таблице

    Powershell взаимодействует с открытым Excel

    Как вы извлекаете подмассив из массива в функцию листа?

    Как вы извлекаете содержимое конкретной ячейки (строки, столбца) документа Microsoft Excel, которое охватывает более 1000 «Таблиц»?

    Excel VBA Создайте AcroPDF программно

    Сбросить выбор списка в VBA

    Копировать сводную таблицу и вставить без форматирования таблицы сводных таблиц

    APEX: прочитайте загруженный файл excel с помощью as_read_xlsx

    Доступ к VBA: удаление строк Excel, где значение ячейки соответствует значению в таблице Access

    Автоматически выполнять макрос

    VBA вложен в цикл, только один цикл продвигается

    Давайте будем гением компьютера.