我想用 Excel VBA 計算檔案夾中的檔案。
速度現在對我來說非常重要，所以首先我將所有檔案（從檔案夾和子檔案夾）列出到“A”列，我想遍歷所有行并計算檔案夾中有多少檔案。
我來自“A”列的串列：
D:\Steam\libraryfolder.vdf
D:\Steam\steam.dll
D:\Steam\config\appconfig.json
D:\Steam\config\chaperone_info.vrchap
D:\Steam\config\steamvr.vrsettings
D:\Steam\config\lighthouse\lighthousedb.json
D:\Steam\config\lighthouse\lhr-eebe0f79\config.json
D:\Steam\config\lighthouse\lhr-eebe0f79\userdata\Green_46GA163X002581_mura_analyzes.mc
D:\Steam\config\lighthouse\lhr-eebe0f79\userdata\Green_46HA163P000228_mura_analyzes.mc
我想進入“B”列的檔案數。所以“B”列應該是這樣的：
2
2
3
3
3
1
1
2
2
目前我有這個小代碼來計算“”，但不幸的是我不知道如何計算檔案。
Sub test()
Dim S As String
S = "D:\Steam\config\lighthouse\lhr-eebe0f79\config.json"
MsgBox "count = " & UBound(Split(S, "\"))
End Sub
uj5u.com熱心網友回復：
您不需要 VBA，標準 Excel 函式可以計算這些計數。
B 列用于從路徑中提取檔案名：
=MID(A1,FIND("*",SUBSTITUTE(A1,"\","*",LEN(A1)-LEN(SUBSTITUTE(A1,"\","")))) 1,LEN(A1))
然后使用列 C 提取路徑：
=LEFT(A1,LEN(A1)-LEN(B1))
最后，D 列可以計算駐留在同一目錄中的檔案數：
=COUNTIF(C:C,$C1)
如果您確實需要在 VBA 中執行此操作，那么這里有幾個函式可以在給定完整路徑的情況下提取檔案名或目錄：
' Returns the file name given a full file path
Function BaseName(FilePath)
BaseName = Mid(FilePath, InStrRev(FilePath, "\") 1)
End Function
' Returns the directory path given a full file path
Function DirName(FilePath)
DirName = Mid(FilePath, 1, Len(FilePath) - Len(BaseName(FilePath)))
End Function
uj5u.com熱心網友回復：
從檔案路徑串列中計算檔案夾中的檔案
- 給定的檔案路徑串列位于
A2:A20. - 第一個程序的結果 ,
CountFilesPerFolder在 中B2:B20。 - 第二個程序的結果 ,
ListFilesCountPerFolder在 中E2:F8。
獲取檔案夾路徑的 Excel 公式 ( Evaluate)
=LEFT(A2,FIND("*",SUBSTITUTE(A2,"\","*",LEN(A2)-LEN(SUBSTITUTE(A2,"\",""))))-1)
代碼
Option Explicit
Sub CountFilesPerFolder()
' Source
Const sCol As String = "A"
' Destination
Const dCol As String = "B"
' Both
Const fRow As Long = 2
' Reference the worksheet.
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
' Reference the one-column range containing the file paths by using
' the End property to calculate the last row.
Dim slRow As Long: slRow = ws.Cells(ws.Rows.Count, sCol).End(xlUp).Row
Dim rCount As Long: rCount = slRow - fRow 1
If rCount < 1 Then Exit Sub ' column range is empty
Dim srg As Range: Set srg = ws.Cells(fRow, sCol).Resize(rCount)
Dim sAddress As String: sAddress = srg.Address
' Write the folder paths to an array by using the Evaluate method.
Dim Data As Variant
Data = ws.Evaluate("LEFT(" & sAddress & ",FIND(""*"",SUBSTITUTE(" _
& sAddress & ",""\"",""*"",LEN(" & sAddress & ")-LEN(SUBSTITUTE(" _
& sAddress & ",""\"",""""))))-1)")
' Write the folder paths from the array to the keys of a dictionary
' using its items to count the files.
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
Dim Key As Variant
Dim r As Long
For r = 1 To rCount
Key = Data(r, 1)
If Not IsError(Key) Then
If Len(Key) > 0 Then
dict(Key) = dict(Key) 1
End If
End If
Next r
If dict.Count = 0 Then Exit Sub ' only blanks and error values
' Write the files count from the items of the dictionary
' to the array (overwriting the folder paths).
For r = 1 To rCount
Key = Data(r, 1)
If dict.Exists(Key) Then
Data(r, 1) = dict(Key)
Else
Data(r, 1) = Empty
End If
Next r
' Write the files count from the array to the destination one-column range
' and clear the contents below.
With srg.EntireRow.Columns(dCol)
.Resize(rCount).Value = Data
.Resize(ws.Rows.Count - .Row - rCount 1).Offset(rCount).ClearContents
End With
End Sub
Sub ListFilesCountPerFolder()
' Source
Const sCol As String = "A"
' Destination
Const dCol As String = "E"
' Both
Const fRow As Long = 2
' Reference the worksheet.
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
' Reference the one-column range containing the file paths by using
' the End property to calculate the last row.
Dim slRow As Long: slRow = ws.Cells(ws.Rows.Count, sCol).End(xlUp).Row
Dim rCount As Long: rCount = slRow - fRow 1
If rCount < 1 Then Exit Sub ' column range is empty
Dim srg As Range: Set srg = ws.Cells(fRow, sCol).Resize(rCount)
Dim sAddress As String: sAddress = srg.Address
' Write the folder paths to an array by using the Evaluate method.
Dim Data As Variant
Data = ws.Evaluate("LEFT(" & sAddress & ",FIND(""*"",SUBSTITUTE(" _
& sAddress & ",""\"",""*"",LEN(" & sAddress & ")-LEN(SUBSTITUTE(" _
& sAddress & ",""\"",""""))))-1)")
' Write the folder paths from the array to the keys of a dictionary
' using its items to count the files.
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
Dim Key As Variant
Dim r As Long
For r = 1 To rCount
Key = Data(r, 1)
If Not IsError(Key) Then
If Len(Key) > 0 Then
dict(Key) = dict(Key) 1
End If
End If
Next r
rCount = dict.Count
If rCount = 0 Then Exit Sub ' only blanks and error values
' Resize the array according to the number of key-value pairs
' of the dictionary and write the data from the dictionary to the array.
ReDim Data(1 To rCount, 1 To 2)
r = 0
For Each Key In dict.Keys
r = r 1: Data(r, 1) = Key: Data(r, 2) = dict(Key)
Next Key
' Write the data from the array to the destination two-column range
' and clear the contents below.
With srg.EntireRow.Columns(dCol).Resize(, 2)
.Resize(rCount).Value = Data
.Resize(ws.Rows.Count - .Row - rCount 1).Offset(rCount).ClearContents
End With
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/440547.html
上一篇：ExcelVBA-組合框