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

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

Ветеран


Contributor


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

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


Вложения
Тип файла: xls данные.xlsm.xls
(27.2 Kb, 22 просмотров)

DimonNT, Для начала, реорганизуем таблицу:
1) листы с данными переименуем в строгом соответствии с названием месяцев. листы с месяцами можно добавлять по мере необходимости
2) создадим лист с названием, например, Свод, нарисуем на нём заголовок и отформатируем для данных
Далее - выполним макрос
Код: Выделить весь код
Sub DimonNT()
    Const rFio = "A2", Svod = "Свод"
    Amon = Array("Январь", "Февраль", "Март", "Апрель", "Май", "Июнь", "Июль", "Август", "Сентябрь", "Октябрь", "Ноябрь", "Декабрь")
    Dim Asum0(0, 11)
    
    For i = 0 To 11
        Asum0(0, i) = 0
    Next
        
    Application.ScreenUpdating = False
    With CreateObject("Scripting.Dictionary")
        For m = 0 To 11
            On Error Resume Next
                Set R = Sheets(Amon(m)).Range(rFio)
                If Err.Number = 0 Then
                    j = 0
                    Do
                        Rv = R.Offset(j, 0).Value
                        If Not .Exists(Rv) Then
                            .Add Rv, Asum0
                        End If
                        Asum = .Item(Rv)
                        Asum(0, m) = Asum(0, m) + R.Offset(j, 1).Value
                        .Item(Rv) = Asum
                        j = j + 1
                    Loop Until Rv = Empty
                End If
            On Error GoTo 0
        Next
        j = 0
        Sheets(Svod).Range(rFio).Resize(10000, 13).ClearContents
        For Each k In .Keys
            Sheets(Svod).Range(rFio).Offset(j, 0) = k
            Sheets(Svod).Range(rFio).Offset(j, 1).Resize(1, 12).Value = .Item(k)
            j = j + 1
        Next
        Application.ScreenUpdating = True
    End With
End Sub
На листе Свод получим объединенные данные. Возможные проблемы - если Фамилия Имя Отчество для одного и того же человека введена на разных листах по разному.
Вашу таблицу с макросом прилагаю. Удалите только из названия файла расширение .xls

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

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

Отправлено: 23:15, 13-04-2023 | #5