Хитрый подсчёт среднего балла

[Антон Олегович]

Можно ли воплотить в жизнь такой алгоритм:
В папке находиться большое количество файлов %name%.xls (примерно 1000), нужно подсчитать среднее значение по одному столбцу в каждом файле, и перенести эти значения в общий файл,с названием каждого файла, по которому производился подсчёт.

Спасибо.

[SAS888]

Если известны имена листов в этих файлах, из которых нужно брать данные, и если известен столбец с данными для подсчета, а также, известно, что максимальное количество строк в столбце может быть не более какого-то значения (это для скорости), то все можно сделать не открывая файлов.

[Антон Олегович]

Сообщение от SAS888

Если известны имена листов в этих файлах, из которых нужно брать данные, и если известен столбец с данными для подсчета, а также, известно, что максимальное количество строк в столбце может быть не более какого-то значения (это для скорости), то все можно сделать не открывая файлов.

1. Имена файлов известны,вид у них такой: 00_000000_00
2.Столбец N
3.Максимальное количество строк 400

[SAS888]

А имена листов в этих файлах?
Обрабатывать все xls файлы, или файлы с другими расширениями, или все файлы, имеющие вид 00_000000_00?

[Антон Олегович]

Сообщение от SAS888

А имена листов в этих файлах?
Обрабатывать все xls файлы, или файлы с другими расширениями, или все файлы, имеющие вид 00_000000_00?

Файлы с расширением xls,а вд названия у них 00_000000_00, название листа у всех Выполнение заданий.Вот один из файлов12_101001_1.rar

[SAS888]

Попробуйте на пустом листе выполнить макрос:

Sub Main()
    Dim myPath As String, myName As String, avr As Double, i As Long, j As Long
    Application.ScreenUpdating = False
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Укажите рабочую папку"
        .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        myPath = .SelectedItems(1) & "\"
    End With
    myName = Dir(myPath & "*.xls"): j = 1
    Do While myName <> ""
        With Sheets(2).[A7:A400]
            Sheets(2).Cells.ClearContents
            .Formula = "='" & myPath & "[" & myName & "]Выполнение заданий'!$N$7:$N$400"
            .Value = .Value
        End With
        For i = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row To 7 Step -1
            If Sheets(2).Cells(i, 1) = 0 Then Sheets(2).Rows(i).Delete
        Next
        Cells(j, 1) = myName: Cells(j, 2) = Application.Average(Sheets(2).UsedRange): j = j + 1
        Sheets(2).Cells.ClearContents
        myName = Dir
    Loop
End Sub

Скажу сразу, работоспособность не проверял. Проверьте сами.
В процессе работы макрос использует второй лист для временного размещения данных. Поэтому, во-первых, запускать макрос нужно при неактивном втором листе, во вторых, второй лист должен обязательно присутствовать и быть пустым. Если нужно, можно макросом создавать временный лист, с последующим удалением.

P.S. Макрос обрабатывает все файлы в указанной папке с расширением ".xls". Если нужно, можно наложить маску с шаблоном на имена файлов и обрабатывать только те, которые имеют вид ##_######_##.xls

[Антон Олегович]

Всё работает, спасибо большое