修改

Question

我有一个带有唯一标识号的项目，其中有一个文件夹和子文件夹，用于命名为未选中并已选中，这两个文件夹都包含pdf文件。我目前有一个电子表格，可自动检查这些文件夹并计算每个文件中的文件数量，然后显示未经检查的已检查百分比。

但是，我想推出这个电子表格，以涵盖多个服务器上的一个以上项目（所有项目都有一个唯一的编号）。目前我一直在手动输入文件夹的路径，但我想知道是否有一种方法可以自动执行此操作。

以下是我希望电子表格完成的内容： -

最终用户选择项目文件夹所在的服务器（可能通过单选按钮）
然后输入唯一的项目编号。
电子表格搜索已搜索项目编号的列表。
如果项目编号已在列表中，则跳过下一步。
电子表格然后在所选服务器中搜索项目文件夹，然后在其中搜索已选中/未选中的文件夹。
然后计算已检查/未检查文件夹中的文件并显示％。
如果搜索了新的项目编号，那么保存在列表中的项目编号以及文件夹路径中（我认为这会加快下次最终用户再次搜索相同项目编号的过程）
如果找不到项目编号，请返回msg检查项目编号，然后重试。

这是我已有的代码

Private Sub unchecked_pdf()
Worksheets("cover").Activate
Range("K5:L6").ClearContents
Range("M5").ClearContents
' Clears cell contents on open

Dim FolderPath As String, path As String, count As Integer
FolderPath = Range("U3").Value
' looks in spercific folder from cell value
path = FolderPath & "*.pdf"
' for file type this time it is pdf files, though if you change this is could be word files, or psd's
FileName = Dir(path)

Do While FileName <> ""
    count = count + 1
    FileName = Dir()
Loop

Range("M5").Value = count
' puts final count value in cell

End Sub
Private Sub checked_loading()

Range("M6").ClearContents

Dim FolderPath As String, path As String, count As Integer
FolderPath = Range("U4").Value

path = FolderPath & "*.pdf"

FileName = Dir(path)

Do While FileName <> ""
    count = count + 1
    FileName = Dir()
Loop

Range("M6").Value = count

Range("N5").Formula = "=Sum(M5,M6)"
Range("K5").Formula = "=IF(N5=0,0.00,SUM(M6/N5*1))"
' addes formula to selected cells to give percentage
End Sub

如果您需要有关我想要实现的内容的更多信息，那么任何有关此方面的帮助都将非常受欢迎，然后发表评论，我将尽力澄清。

Answer 1

这应该是一个宏。依赖于VBA和excel公式的组合会导致比使用一个或另一个100％更多的问题（只要你有这个选项）。

因此，例如，这是一个更简单的整体结构：

Sub CountPDFs()

    Dim lngChecked As Long
    Dim lngUnchecked As Long
    Dim lngTotal As Long
    Dim dblPercentageChecked As Double
    Dim bPreviouslyChecked As Boolean

    '/ Check against previous paths

        If bPreviouslyChecked = False _
            Then

                '/ Define path for Checked

                CountFiles path, lngChecked, lngTotal

                '/ Define path for unchecked

                CountFiles path, lngUnchecked, lngTotal

                dblPercentageChecked = lngChecked / lngTotal

                '/ Put percentage in cells
        End If

End Sub

Private Sub CountFiles(ByVal strFilePath As String, ByRef lngCounter As Long, ByRef lngTotalCounter As Long)

    Dim strFileName As String

        strFileName = Dir(strFilePath)
        Do Until strFileName = ""
            lngCounter = lngCounter + 1
            lngTotalCounter = lngTotalCounter + 1
            strFileName = Dir()
        Loop
End Sub

Answer 2

Private Sub LocatePDF()

Dim CorePath As String
Dim CoreJobNum As String
Dim JobNum As String
Dim Location As String
Dim Folder As String
Dim OverallPath As String
Dim FolderPath As String, path As String, Count As Integer

CorePath = "C:\"
CoreJobNum = Range("Cover!AC4").Value
JobNum = Range("Cover!F3").Value
Folder = Range("Cover!U3").Value

OverallPath = CorePath + CoreJobNum + JobNum + Location

 Dim MyArray(0 To 16) As String
  MyArray(1) = "\Loading\Unchecked\"
  MyArray(2) = "\Loading\Checked\"
  MyArray(3) = "\Stability\Unchecked\"
  MyArray(4) = "\Stability\Checked\"
  MyArray(5) = "\Beams\Unchecked\"
  MyArray(6) = "\Beams\Checked\"
  MyArray(7) = "\Columns\Unchecked\"
  MyArray(8) = "\Columns\Checked\"
  MyArray(9) = "\Foundations & Substructure\Unchecked\"
  MyArray(10) = "\Foundations & Substructure\Checked\"
  MyArray(11) = "\Elevations & Walls\Unchecked\"
  MyArray(12) = "\Elevations & Walls\Checked\"
  MyArray(13) = "\Slabs\Unchecked\"
  MyArray(14) = "\Slabs\Checked\"
  MyArray(15) = "\Misc\Unchecked\"
  MyArray(16) = "\Misc\Checked\"

 For i = 1 To UBound(MyArray)
FolderPath = OverallPath + MyArray(i)
' looks in spercific folder
path = FolderPath & "*.pdf"
'for file type this time it is pdf files
FileName = Dir(path)
Do While FileName <> ""
' checks for filename <less than or> greater than "filename" as "" is empty does not,
' look for spercific file
Count = Count + 1
' counts amount of pdf files, add 1 to the last known number
FileName = Dir()
Loop

Cells(i, 13).Value = Count
Count = 0

下一步

End Sub

所以这并没有完全回答我的问题，虽然它确实完成了大部分要求，但目前唯一的问题是：

用户可以根据他们使用的服务器更改作业编号列表。
使用单元格（i，13）将最终计数写入M9而不是M1.Value = Count

我试过这个： -

Dim rOutput As Range
Set rOutput = Range("M9:M24")
For Each Output In rOutput
Cells(i,13).Value = Count
Next

虽然我收到以下错误（我也不认为这是正确的方法。）

For Each control variable must be Variant or Object.

任何帮助都会很棒

修改

我已经改变了

Dim rOutput As Range
Set rOutput = Range("M9:M24")
For Each Output In rOutput
Cells(i,13).Value = Count
Next

对于

Dim LastRow As Long, ws As Worksheet
Set ws = Sheets("Cover")

LastRow = ws.Range("m" & Rows.Count).End(xlUp).Row + 1

ws.Range("M" & LastRow).Value = Count
Count = 0

它现在有效（在我在单元格M8中隐藏了一个值之后）

在Excel中查找并保存文件路径

2 个答案:

修改