Question

我的目标是编写允许以下内容的VBA宏：

选择要打开文件的文件夹
然后计算每个文件中的行数（每个文件只包含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。 First result生成此代码：

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，we get the second result。第一个结果是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，这样我们就可以遍历文件。剩下的两件事是什么？好吧，计算用过的行 AND 移动文件。对于使用过的行，我会破解一个简单的函数来检查工作簿的唯一工作表，看看该行是否为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

现在这很简单。接下来，让我们编写一个简单的代码来移动文件。出于个人目的，我会将代码写入 copy 。它会由你来修改它以便移动，因为这是一个相当敏感的操作，如果它搞砸了......好吧。嗯。但这里的一些东西告诉我，有一个更好的选择。复制可能导致所有错误的行为从拒绝许可到错误复制。由于我们已将文件打开，为什么不将保存而不是新文件夹？

现在，让我们把它们整齐地绑在一起。

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的内置功能来选择文件夹并获取一组文件名。

然而，那里有一个有趣的问题：

那些只有.csv文本文件的单页Excel文件工作簿吗？

如果他们有.csv扩展名，则无需在Excel中打开它们来计算行数！

以下是执行此操作的代码：

用于计算CSV文件中的行的快速VBA

 
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并使用此字节数组而不是strChunk来从为二进制读取打开的文件中接收Get。

有两个理由没有以'正确'的方式做到这一点：

最后Get，它将设置文件结尾为TRUE，将从中提取更少的数据文件比完整的“块”。接下来发生的事情是文件的最后几个字节被写入数组而不清除前一个'Get'中的数据。所以你必须做额外的管道工作，计算与LOF(#hwndFile)关闭的字节以检测'Last Get'并分支到清除缓冲区的语句，或者分配一个较小的字节数组并使用它代替;

VBA String类型是一个带有包装器的字节数组，允许您的代码（或者说编译器）在后台处理所有复杂性。

然而，使用旧式Get语句返回原始C比使用Scripting.FileSystemObject之类的后续库要快得多。此外，您有能力检查字节级别的传入数据，以调试您正在获取的问题'???????'字符而不是您期望的文字。

无论如何：这是游戏的后期，因为StackOverflow的回答是，并且它是你问题中不那么有趣的部分的答案。但是对于那些需要在他们的数据文件中快速计算行数的人来说会很有趣，而且当他们搜索时你的问题出现在列表的顶部。

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

2 个答案:

用于计算CSV文件中的行的快速VBA