如何计算行数并使用VBA宏自动移动文件？

Question

我的目标是编写一个VBA宏，该宏将允许：

1. 选择包含要打开文件的文件夹
2. 然后计算每个文件中的行数（每个文件仅包含一张纸）。
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年及更高版本。 这是代码，应用了Siddharth Rout详细介绍的正确更正。

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文件中的行进行计数

Public Function FileRowCount(FilePath As String, Optional RowDelimiter As String = vbCr) As Long
' Returns the row count of a text file, including the header row
' Returns - 1 on error

' Unicode-compliant, works on UTF-8, UTF-16, ASCII, with or without a Byte order Marker.
' Reads a typical 30Mb file over the network in 200-300ms. Hint: always copy to a local folder.

' If you're scanning files for use with a SQL driver, use basSQL.TableRowCount: it's 20x slower,
' but it returns a proper test of the file's usability as a SQL 'table'

' Nigel Heffernan    Excellerando.Blogspot.com  2015

' Unit test:
' s=Timer : for i = 0 to 99 : n=FileRowCount("C:\Temp\MyFile.csv") : Next i : Print Format(n,"#,##0") & " rows in " & FORMAT((Timer-s)/i,"0.000") & " sec"

' Network performance on a good day: reads ~ 150 MB/second, plus an overhead of 70 ms for each file
' Local-drive performance:                 ~ 4.5 GB/second, plus an overhead of  4 ms for each file

On Error Resume Next

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

If Len(Dir(FilePath, vbNormal)) < 1 Then
    FileRowCount = -1
    Exit Function
End If

' trap the error of a folder path without a filename:
If FileName(FilePath) = "" Then
    FileRowCount = -1
    Exit Function
End If

 
    hndFile = FreeFile
    Open FilePath For Binary Access Read Shared As #hndFile


    lngFileLen = LOF(hndFile)


    lngOffset = 1
    Do Until EOF(hndFile)
        Get #hndFile, , strChunk
        FileRowCount = FileRowCount + UBound(Split(strChunk, RowDelimiter))
    Loop


    Close #hndFile
    Erase arrBytes

End Function



Public Function FileName(Path As String) As String
' Strip the folder and path from a file's path string, leaving only the file name

' This does not check for the existence or accessibility of the file:
' all we're doing here is string-handling

' Nigel Heffernan    Excellerando.Blogspot.com  2011

Dim strPath   As String
Dim arrPath() As String

Const BACKSLASH As String * 1 = "\"

strPath = Trim(Path)

If strPath = "" Then Exit Function
If Right$(strPath, 1) = BACKSLASH Then Exit Function

arrPath = Split(strPath, BACKSLASH)

If UBound(arrPath) = 0 Then          ' does not contain "\"
    FileName = Path
Else
    FileName = arrPath(UBound(arrPath))
End If

Erase arrPath

End Function

请注意使用Split函数对行分隔符进行计数：VBA的字符串处理通常较慢，尤其是在连接字符串时，但是VBA在很多地方可以执行字符串操作而无需内部分配和释放。 如果知道它们在哪里，就会发现代码的某些部分的运行速度与“ C”开发人员的最佳工作一样快。

警告：可怕的黑客严格来说，我应该将Dim arrBytes(CHUNK_SIZE) As Byte声明Dim arrBytes(CHUNK_SIZE) As Byte并使用此Byte数组而不是strChunk来接收为二进制读取而打开的文件中的Get 。

不按“正确”方式进行操作有两个原因：

1. 最后一个Get （将文件结尾设置为TRUE）将从文件中提取的数据少于完整的“块”。 接下来发生的是，文件的最后几个字节被写入数组， 而没有清除前一个“ Get”中的数据 。 因此，您必须执行其他操作，根据LOF(#hwndFile)计数字节以检测“最后一次获取”，然后跳转到一条清除缓冲区的语句中，或者分配一个较小的字节数组并使用它；
2. 如果您在行定界符周围进行一些字节数组替换，则该代码将仅处理UTF-8 2字节编码的字符集，或单字节编码的ASCII“拉丁”文本。

VBA String类型是带有包装器的字节数组，该包装器允许您的代码（或更确切地说，编译器）在后台处理所有这些复杂性。

但是，使用老式的Get语句返回原始C的速度比使用诸如Scripting.FileSystemObject类的更高版本的库要快得多。 另外，您还可以在字节级别检查传入的数据，以调试出现“ ???????”的问题。 字符，而不是您期望的文本。

无论如何：随着StackOverflow答案的推出，这已经很晚了，它是对问题中不那么有趣的部分的答案。 但这对于需要在数据文件中快速进行行计数的人们将很有趣，而您的问题在搜索时就位于列表的顶部。