Как подсчитать количество строк в книгах из подпапок в VBA?

Я пытаюсь подсчитать количество строк в файлах из некоторых папок и подпапок. Папки и папки вложенных папок записываются в столбце G.

Sub CountRows() Dim wbSource As Workbook, wbDest As Workbook Dim wsSource As Worksheet, wsDest As Worksheet Dim strFolder As String, strFile As String Dim lngNextRow As Long, lngRowCount As Long Dim LastRow Dim cl As Range Application.ScreenUpdating = False Set wbDest = ActiveWorkbook Set wsDest = wbDest.ActiveSheet LastRow = wsDest.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row For Each cl In wsDest.Range("G11:G" & LastRow) strFolder = cl.Value strFile = Dir(strFolder & "/") lngNextRow = 11 Do While Len(strFile) > 0 Set wbSource = Workbooks.Open(Filename:=strFolder & "/" & strFile) Set wsSource = wbSource.Worksheets(1) lngRowCount = wsSource.UsedRange.Rows.Count wsDest.Cells(lngNextRow, "F").Value = lngRowCount - 1 wbSource.Close savechanges:=False lngNextRow = lngNextRow + 1 strFile = Dir Loop Next cl ... 

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

Например, если у меня есть 1 папка с 3 файлами, в столбце GI будет 3 каталога (по 1 директории для каждого из 3-х файлов C: \ Users \ Desktop \ vba_files \ и т. Д.), Тогда я получу 3 числа в столбце F, – количество строк в каждой книге из папки C: \ Users \ Desktop \ vba_files \, но каждый счет повторяется 3 раза (по количеству каталогов).

Он выглядит следующим образом:

введите описание изображения здесь

В коде есть проблема с логикой. Вы начинаете с столбца G, содержащего запись для каждого файла, поэтому для папки с 3 файлами имеется 3 повторяющихся строки. Но цикл Do While возвращает длину для каждого файла в текущем каталоге (поскольку вы продолжаете называть Dir без аргументов). Затем цикл For Each переходит к следующей ячейке в столбце G, которая снова содержит тот же каталог, цикл Do While начинается снова, и вы получаете еще 3 записи в столбце F.

Я не уверен, почему вы хотели бы начать с того, что столбец G имеет эти повторы, но если вы это сделаете, вам нужен только один цикл, который пробегает каждую ячейку в столбце G и проверяет, изменился ли каталог каждый раз. Ниже приведен код:

 Sub CountRows() Dim wbSource As Workbook, wbDest As Workbook Dim wsSource As Worksheet, wsDest As Worksheet Dim strFolder As String, strFile As String Dim lngNextRow As Long, lngRowCount As Long Dim LastRow Dim cl As Range 'Application.ScreenUpdating = False Set wbDest = ActiveWorkbook Set wsDest = wbDest.ActiveSheet LastRow = wsDest.Cells(wsDest.rows.count,7).end(xlUp).Row lngNextRow = 11 strFolder = "" For Each cl In wsDest.Range("G11:G" & LastRow) If cl.Value <> strFolder Then strFolder = cl.Value strFile = Dir(strFolder & "/*.xl*") Else strFile = Dir End If If Len(strFile) > 0 Then Set wbSource = Workbooks.Open(Filename:=strFolder & "/" & strFile) Set wsSource = wbSource.Worksheets(1) lngRowCount = wsSource.UsedRange.Rows.Count wsDest.Cells(lngNextRow, "F").Value = lngRowCount - 1 wbSource.Close savechanges:=False lngNextRow = lngNextRow + 1 End If Next cl End Sub 

Обратите внимание: если количество файлов в каталоге больше числа соответствующих записей в столбце G, то дополнительные файлы будут игнорироваться.

Я добавил фильтр к первому вызову Dir() чтобы выбрать только файлы Excel. Я также изменил способ, которым LastRow рассчитан на несколько более безопасный способ (ваш код дал бы неправильные результаты, если бы были какие-либо данные ниже и справа от последней ячейки в G).

Возможно, более быстрый способ добиться чего-то подобного:

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

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

Interesting Posts

Ошибка VBA: значение, используемое в формуле, является неправильным типом данных?

Как вернуть диапазон ячеек (например, A10: C20) из именованного диапазона в Excel с помощью PowerShell

Макрос VBA, который находит правильное место для копирования пасты в

Данные VBA скремблирования с нескольких веб-сайтов

Для петель VBA. Программа Macro Excel

workheet.iter_rows () не вытягивает данные из таблицы

Объединение нескольких листов на 1 лист

Создайте шаг Excel для каждого случая на шаге Switch / Case в Pentaho

OleDB интерпретирует неправильную строку как заголовок в файлах XLS / XLSX

VBA, чтобы проверить, не является ли какая-либо ячейка пустой в заданном диапазоне

Как разбить большой файл .csv на небольшие файлы на основе нескольких условий?

Горизонтальное совпадение индексов (возврат заголовка столбца)

Невозможно разделить содержимое ячейки по разрыву строк

Как импортировать текстовый файл в excel с помощью java?

Как я могу управлять блокировками и видимостью строк / столбцов в офисе js api

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