Имя пользователя:
Пароль:
 

Показать сообщение отдельно

Ветеран


Contributor


Сообщения: 2735
Благодарности: 1699

Профиль | Отправить PM | Цитировать


romfus, Я, наверное, лезу не в своё дело, но постановку задачи я переосмыслил.
Я написал vbs-скрипт, который объединит в одну все Ваши таблицы,
Код: Выделить весь код
inName = "Z:\Soft_In"

With WScript.Arguments
    If .Count <> 0 Then inName = .Item(0)
End With

Set FSO = CreateObject("Scripting.FileSystemObject")

On Error Resume Next
Set nDir = FSO.GetFolder(inName)
If Err.Number <> 0 Then
    MsgBox inName + vbCrLf + Err.Description
    WScript.Quit 1
End If
On Error GoTo 0

Tit = Array("num", "indexto", "region", "area", "city", "adres", "adresat", "mass", "value", "payment", "comment")
NTit = UBound(Tit) - LBound(Tit)

inExt = "xls"
Rng1 = "A1"
Rng2 = "B1"

Set AllFiles = nDir.Files

With CreateObject("Excel.Application")
    .Visible = True
    .Workbooks.Add

    CN = .Range(Rng1).Offset(0, NTit).Address
    .Range(Rng1 + ":" + CN).Value = Tit
    Cont = .Range(Rng2)
    ii = 0
        
    For Each iFile In AllFiles
        If LCase(inExt) = LCase(FSO.GetExtensionName(iFile)) Then
            .Workbooks.Open (iFile)
            i = 0
            If .Range(Rng2) = Cont Then
                Do
                    If Trim(.Range(Rng2).Offset(i + 1, 0)) = "" Then Exit Do
                    i = i + 1
                Loop
                R0 = .Range(Rng1).Offset(1, 0).Address
                RN = .Range(Rng1).Offset(i, NTit).Address
                Mas = .Range(R0 + ":" + RN)
            End If
            .ActiveWorkbook.Close
            .Range(R0 + ":" + RN).Offset(ii, 0).NumberFormat = "@"
            .Range(R0 + ":" + RN).Offset(ii, 0) = Mas
            ii = ii + i
        End If
    Next
    R0 = .Range(Rng2).Offset(1, 0).Address
    RN = .Range(Rng2).Offset(ii, 0).Address
    RF = .Range(Rng2).Offset(ii + 1, 0).Address
    
    .ActiveWindow.SplitRow = 1
    .ActiveWindow.FreezePanes = True
    
    .Columns("A:A").EntireColumn.AutoFit
    .Range(Rng2).AutoFilter
    .Range(RF).FormulaLocal = "=ПРОМЕЖУТОЧНЫЕ.ИТОГИ(3;" + R0 + ":" + RN + ")"
    .Rows(CStr(.Range(Rng2).Row)).Insert (xlDown)
    .Range(Rng2).FormulaLocal = "=" + .Range(RF).Offset(1, 0).Address

End With
затем накладывает на нее фильтр и прописывает формулу подсчета отфильтрованных значений. Если данных не слишком много, это сработает.
Что плохо в этом решении: конечно, сборка отработает медленнее. Я не знаю, сколько строк получится в итоговой таблице.
Что хорошо: после сборки при необходимости выборки нескольких индексов этот процесс быстр и удобен. Плюс, имеем полную инфу по каждому адресату. Можем выбирать сразу несколько индексов и подсчитывать их количество.
Можем выбрать инфу и по другому полю.
Обрабатываемую папку можно указать явно, например, как сейчас: inName = "Z:\Soft_In" (пропишИте своё!).
Однако, если при запуске скрипта папку указать в аргументе, то возьмётся не явное описание из текста скрипта, а то, что в аргументе.
Как следствие, на этот скрипт можно создать, например, на рабочем столе значок, и затягивать на него из проводника нужную папку .

-------
Даже самая сложная проблема обязательно имеет простое, лёгкое для понимания, неправильное решение. Каждое решение плодит новые проблемы.


Последний раз редактировалось megaloman, 21-04-2018 в 16:16.

Это сообщение посчитали полезным следующие участники:

Отправлено: 15:56, 21-04-2018 | #18