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

Question

Моя цель - написать макросы VBA, которые позволят:

1. выбрать папку с файлами для открытия
2. затем подсчитать количество строк в каждом файле (каждый файл содержит только 1 лист).
3. переместить в другую папку все файлы, которые содержат более 1 строки

Я очень новичок в VBA, поэтому я нашел способ подсчета количества строк в активном листе, но я все еще не могу автоматически управлять открытием и перемещением файлов в другую папку:

Sub RowCount()
    Dim iAreaCount As Integer
    Dim i As Integer
    Worksheets("Sheet1").Activate
    iAreaCount = Selection.Areas.Count
    If iAreaCount <= 1 Then
        MsgBox "The selection contains " & Selection.Rows.Count & " rows."
    Else
        For i = 1 To iAreaCount
            MsgBox "Area " & i & " of the selection contains " & _
            Selection.Areas(i).Rows.Count & " rows."
        Next i
    End If
End Sub

Может ли кто-нибудь помочь с этим, пожалуйста?

Answer 1

Это на самом деле просто. Действительно легко.:)

Во-первых, код, чтобы выбрать папку для просмотра файлов Excel. Использовал Google и искал excel vba select folder dialog, Первый результат дает этот код:

Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function

Мы будем использовать его позже. Далее нам нужен цикл для подсчета количества строк в каждом файле / листе. Однако мы не можем считать их без открытых файлов. Итак, давайте посмотрим на код, который открывает книги в цикле. погуглить excel vba open excel files in folder мы получаем второй результат. Первый результат - устаревший метод в Excel 2007 и выше. Я буду предполагать, что вы работаете в 2007 году и выше. Вот код, применяющий правильную коррекцию, детализированную Сиддхартом Раутом.

Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
MyFolder = "Blah blah blah"
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile
MyFile = Dir
Loop
End Sub

Теперь несколько передовых лучших практик. Вместо того, чтобы открывать каждую рабочую книгу / рабочий лист / файл и подсчитывать строки в каждом из открытых файлов (что крайне нелогично), давайте изменим приведенный выше код для подсчета строк в каждом файле, а затем переместим их в другую папку, если у них есть более чем одна (1) используемая строка. Мы также изменим приведенный выше код, чтобы учесть и первую функцию для получения папки, к которой мы хотим применить второй код.

Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
MyFolder = GetFolder("C:\users\yourname\Desktop" 'Modify as needed.
MyFile = Dir(MyFolder & "\*.xlsx") 'Modify as needed.
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile
MyFile = Dir
Loop
End Sub

Видишь, что там произошло? Мы назвали GetFolder функции и назначил его MyFolder, Затем мы объединяем MyFolder и подстановочную строку, а затем передать ее Dir так что мы можем зациклить файлы. Какие оставшиеся две вещи? Хорошо, посчитайте использованные строки И переместите файлы. Для используемых строк я взломаю простую функцию, чтобы проверить единственный лист рабочей книги, чтобы увидеть, является ли строка 2 или больше.

Function CountUsedRows(Wbk As Workbook) As Long
    Dim WS As Worksheet
    Set WS = Wbk.Sheets(1)
    CountUsedRows = WS.Range("A" & Rows.Count).End(xlUp).Row 'Modify as necessary.
End Function

Теперь это достаточно просто. Далее давайте напишем простой код для перемещения файлов. В личных целях я напишу код для копирования. Вам придется изменить его для перемещения, поскольку это довольно чувствительная операция, и если она испортится... хорошо. Хм. Но что-то здесь говорит мне, что есть гораздо лучший вариант. Копирование может привести к возникновению любых ошибок: от отказа в разрешении до ошибочного копирования. Поскольку у нас открыт файл, почему бы просто не сохранить их в новой папке?

Теперь давайте аккуратно свяжем их все вместе.

Sub OpenFiles()
    Dim MyFolder As String
    Dim MyFile As String
    Dim TargetWB As Workbook
    MyFolder = GetFolder("C:\Users\yourname\Desktop") 'Modify as needed.
    MyFile = Dir(MyFolder & "\*.xlsx") 'Modify as needed.
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Do While MyFile <> ""
        Set TargetWB = Workbooks.Open(Filename:=MyFolder & "\" & MyFile)
        With TargetWB
            If CountUsedRows(TargetWB) > 1 Then
                .SaveAs "C:\Users\yourname\Desktop\Blah\CopyOf" & MyFile 'Modify as needed.
            End If
            .Close
        End With
    MyFile = Dir
    Loop
    Shell "explorer.exe C:\Users\yourname\Desktop\Blah", vbMaximizedFocus 'Open the folder.
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Function GetFolder(strPath As String) As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
    NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

Function CountUsedRows(Wbk As Workbook) As Long
    Dim WS As Worksheet
    Set WS = Wbk.Sheets(1)
    CountUsedRows = WS.Range("A" & Rows.Count).End(xlUp).Row 'Modify as necessary.
End Function

Пробовал и проверял. Дайте нам знать, если это работает для вас.

Answer 2

Хороший ответ из Манхэттена: именно так я использую встроенную функциональность Excel, чтобы выбрать папку и получить набор имен файлов.

Однако, там есть интересный побочный вопрос:

Являются ли эти одностраничные книги Excel файлами только текстовых файлов.csv?

Если они имеют расширение.csv, вам не нужно открывать их в Excel для подсчета строк!

Вот код для этого:

Быстрый VBA для подсчета строк в файле CSV

 
Открытая функция FileRowCount(FilePath As String, необязательный RowDelimiter As String = vbCr) As Long
'Возвращает количество строк текстового файла, включая строку заголовка' Returns - 1 при ошибке 
 ' Unicode-совместимый, работает на UTF-8, UTF-16, ASCII, с маркером порядка байтов или без него.
'Считывает типичный файл 30 Мб по сети за 200-300 мс. Подсказка: всегда копируйте в локальную папку. 
 "Если вы сканируете файлы для использования с драйвером SQL, используйте basSQL.TableRowCount: это в 20 раз медленнее", но возвращает правильный тест удобства использования файла в виде "таблицы" SQL 
 Найджел Хеффернан Excellerando.Blogspot.com 2015 
 'Юнит-тест:
' s= Таймер: для i = от 0 до 99: n=FileRowCount("C:\Temp\MyFile.csv"): Далее i: Формат печати (n,"#,##0") & " строки в " & FORMAT((Timer-s)/i,"0.000") & " sec" 
 "Производительность сети в хороший день: считывание ~ 150 МБ / с плюс издержки 70 мс для каждого файла" Производительность локального диска:                 ~ 4,5 ГБ / с плюс накладные расходы 4 мс для каждого файла 
 При ошибке возобновить следующее 
 Dim hndFile As Long Dim lngRowCount As Long Dim lngOffset As Long Dim lngFileLen As Long 
 Const CHUNK_SIZE As Long = 8192 
 Dim strChunk As String * CHUNK_SIZE 
 Если Len(Dir(FilePath, vbNormal)) < 1, то FileRowCount = -1 Выход из функции End If 
 'перехватить ошибку пути к папке без имени файла:
If FileName(FilePath) = "" Then
    FileRowCount = -1 Выход из функции End If 

 hndFile = FreeFile Открыть FilePath для двоичного доступа для чтения как общий доступ #hndFile 

 lngFileLen = LOF (hndFile) 

 lngOffset = 1 делать до EOF(hndFile) Цикл получения #hndFile,, strChunk
        FileRowCount = FileRowCount + UBound(Split(strChunk, RowDelimiter))) 

 Закрыть #hndFile Стереть arrBytes 
 Конечная функция 


 Открытая функция FileName(Path As String) As String
'Удаляет папку и путь из строки пути файла, оставляя только имя файла 
 "Это не проверяет наличие или доступность файла:" все, что мы здесь делаем, это обработка строк 
 Найджел Хеффернан Excellerando.Blogspot.com 2011 
 Dim strPath As String Dim arrPath () As String 
 Const BACKSLASH As String * 1 = "\" 
 strPath = Trim (Path) 
 Если strPath = "", то выйдите из функции, если справа $(strPath, 1) = BACKSLASH, тогда выйдите из функции 
 arrPath = Split (strPath, BACKSLASH) 
 If UBound (arrPath) = 0 Тогда 'не содержит "\"
    FileName = путь, иначе FileName = arrPath(UBound(arrPath))
End If 
 Стереть arrPath 
 Конечная функция 

Обратите внимание на использование Split функция для подсчета разделителей строк: обработка строк в VBA обычно медленная, особенно когда вы объединяете строки, но есть пара мест, где VBA может выполнять манипуляции со строками без внутреннего выделения и освобождения; если вы знаете, где они находятся, вы обнаружите, что части вашего кода выполняются так же быстро, как и лучшая работа разработчика 'C'.

Предупреждение: ужасный хак Строго говоря, я должен объявить Dim arrBytes(CHUNK_SIZE) As Byte и использовать этот массив байтов вместо strChunk получить Get из файла, открытого для двоичного чтения.

Есть две причины не делать это "правильным" способом:

1. Последний Get, который установит TRUE конца файла, будет извлекать меньше данных из файла, чем полный "чанк". Затем происходит то, что эти последние несколько байтов файла записываются в массив без очистки данных из предыдущего "Get". Таким образом, вы должны сделать дополнительную сантехнику, считая байты против LOF(#hwndFile) обнаружение "последнего получения" и переход в оператор, который очищает буфер, или выделяет меньший байтовый массив и использует его вместо этого;
2. Код будет работать только с 2-байтовыми кодированными наборами символов UTF-8 или с однобайтовым латинским текстом ASCII, если вы выполняете небольшую замену байтового массива вокруг разделителей строк.

VBA String type - это байтовый массив с оберткой, которая позволяет вашему коду (или, скорее, компилятору) обрабатывать всю эту сложность в фоновом режиме.

Тем не менее, гораздо быстрее вернуться в изначальный C, используя old-school Get заявления, чем использование более поздних библиотек, таких как Scripting.FileSystemObject, Кроме того, у вас есть возможность исследовать входящие данные на уровне байтов, чтобы отладить проблемы, при которых вы получаете "???????" символы вместо текста, который вы ожидали.

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