Как мне изменить код vba, чтобы он повторялся до конца?

Question

Я нашел фрагмент кода vba, который подсчитывает количество файлов xml в определенной папке, я изменил его, чтобы подсчитывать только файлы с определенной строкой (расположенной в ячейке F3) как часть имени файла. И выведите это количество в соседнюю ячейку (ячейка G3). Работает как положено. Моя проблема в том, что мне нужны результаты для всего диапазона. Диапазон строк создается из сводной таблицы.

Я попытался просто дублировать код и изменить ссылочные ячейки, и это работает. Но диапазон может быть от нескольких строк до 70+, я уверен, что есть гораздо более эффективный и чистый способ, чем запускать код более 70 раз.

Dim FolderPath As String, path As String, count As Integer

FolderPath = "C:\Test\PJC"
path = FolderPath & "\*" & Range("F3") & "*.xml"

FileName = Dir(path)

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

Range("G3").Value = count

Answer 1

Итерации по диапазону могут быть выполнены следующим образом:

Sub IterateRange()

Dim rng As Range, cell As Range
Dim myWs As Worksheet
Set myWs = Application.Worksheets("sheet1")

Set rng = myWs.Range("A1:A6")

For Each cell In rng
    MsgBox cell.Value
Next cell

End Sub

Часто итерация может быть более простой, если использовать свойство .Cells рабочего листа, это может выглядеть так:

Sub IterateRange()

Dim i As Long
Dim myWs As Worksheet
Set myWs = Application.Worksheets("Sheet1")

for i=1 to 6
    MsgBox myWs.Cells(i, 1)
next i

End Sub

Например, если у вас есть строки, которые вы хотите проверить в диапазоне F3: F73, а результаты подсчета должны быть в диапазоне G3: G73, то искомый цикл может выглядеть примерно так:

Sub Example()

Dim FolderPath As String, path As String, count As Integer, i As Integer
Dim myWs As Worksheet
Set myWs = Application.Worksheets("Sheet1")

For i = 3 To 73
count=0
    FolderPath = "C:\Test\PJC"
    path = FolderPath & "\*" & myWs.Cells(i, 6) & "*.xml"

    Filename = Dir(path)

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

    myWs.Cells(i, 7) = count
Next i

End Sub

Чтобы цикл автоматически останавливался после последней строки входных строк, просто добавьте

if myWs.Cells(i, 6)="" then
    exit for
end if

между строками. Для i = 3 - 73 и count = 0

Answer 2

Там у вас есть альтернативы:

    ' One line solution, but can count all files only, without wildcards
    Debug.Print CreateObject("Scripting.FileSystemObject").GetFolder("C:\temp\").Files.count

    ' Counting all *.pdf files in C:\temp
    FolderPath = "\\temp\\"
    Path = "pdf"

    Dim objWMIService   As Object
    Dim objFiles        As Object

    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set objFiles = objWMIService.ExecQuery("Select * from CIM_DataFile where Path = '" & FolderPath & "' and Extension = '" & Path & "'")

    Debug.Print "Files count: ", objFiles.Count

Answer 3

Думаю, это поможет. Я взял ваш код и поместил его в цикл For.

Я определяю начальную строку как строку 3.

EndRange будет искать последнее значение в столбце F. Дляцикл будет повторяться от StartRange до EndRange значений. Я также сделал счетчик для вывода результата из переменной count для каждого цикла в столбце G.

Sub LoopRange()


Dim FolderPath As String, path As String, count As Integer
Dim StartRange As Long, EndRange As Long

StartRange = 3 'Row = 3 for start
EndRange = Cells(Rows.count, "F").End(xlUp).Row 'Find last row in column F

For i = StartRange To EndRange 'Loop from start to end value

    FolderPath = "C:\Test\PJC"
    path = FolderPath & "\*" & Range(Cells(i, "F"), Cells(i, "F")) & "*.xml" 'Take the value from row i and column F in the loop.

    Filename = Dir(path)

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

    Range(Cells(i, "G"), Cells(i, "G")).Value = count 'Print the count

Next i


End Sub