Поиск одинаковых значений в двух ячейках строки и сложение суммы

@Dark_Pingvin · Регистрация: 03.04.2012

Студворк — интернет-сервис помощи студентам

Доброго вам времени суток, товарищи!

Мне необходима ваша квалифицированная помощь. На работе в связи с технологической необходимостью необходимо написать скрипт, который будет искать совпадающие строки по значениям двух ячеек в строке, суммировать их значения времени, записывать в отдельную ячейку сколько строк он сложил и удалять все сложенные строки, кроме одной (с суммарным временем и количеством строк).

Например

Продолж	Источник	Сообщение
0:00:00	51502RB	Сбой цикла работы
0:05:09	51502RB	Сбой цикла работы
0:00:00	51502RB	Сбой цикла работы
0:00:03	51502RB	Сбой цикла работы
0:00:14	51505VR	Размыкание
0:00:00	51505VR	Размыкание

Кол-во	Продолж	Источник	Сообщение
4	0:05:12	51502RB	Сбой цикла работы
2	0:00:14	51505VR	Размыкание

Заранее огромнейшее спасибо за оказание помощи.

@Казанский · 03.04.2012, 14:34

Сводная?

@Dark_Pingvin · 03.04.2012, 15:21 **[ТС]**

к великому сожалению не подходит. начальству нужен скрипт((

@mc-black · 03.04.2012, 16:13

Вот пример вывода отчета под интересующими тебя столбцами в приложенном файле.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub MkReport()
    Dim i As Long, j As Long, k As Long, m As Long
    Dim src(), wsh As Worksheet, t As Date
    
    Set wsh = ThisWorkbook.Worksheets(1)
    
    src = wsh.Range(wsh.Cells(4, 1), wsh.Cells(wsh.Cells(4, 1).End(xlDown).Row, 9)).Value
    m = UBound(src, 1)
    
    j = m + 6
    For i = 1 To m
        If src(i, 1) <> 0 Then
            t = CDate(0)
            For k = i To m
                If src(i, 7) = src(k, 7) And src(i, 9) = src(k, 9) Then
                    t = t + CDate(src(k, 6))
                    src(k, 1) = 0
                End If
            Next
            wsh.Cells(j, 6).Value = Format(t, "hh:mm:ss")
            wsh.Cells(j, 7).Value = src(i, 7)
            wsh.Cells(j, 9).Value = src(i, 9)
            j = j + 1
        End If
    Next
    
    Set wsh = Nothing
End Sub

@Dark_Pingvin · 03.04.2012, 18:34 **[ТС]**

огромнейшее спасибо, это как раз то, что нужно!))
скажите, пожалуйста, а можно этот код научить считать то, что он удалил. то есть, чтобы он писал сколько раз повторялось дублируемое? Заранее признательно благодарен.

@mc-black · 03.04.2012, 18:46

Да, можно, забыл про эту фичу, вот:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Option Explicit
 
Sub MkReport()
    Dim i As Long, j As Long, k As Long, m As Long
    Dim src(), wsh As Worksheet, t As Date, cnt As Long
    
    Set wsh = ThisWorkbook.Worksheets(1)
    
    src = wsh.Range(wsh.Cells(4, 1), wsh.Cells(wsh.Cells(4, 1).End(xlDown).Row, 9)).Value
    m = UBound(src, 1)
    
    j = m + 6
    For i = 1 To m
        If src(i, 1) <> 0 Then
            t = CDate(0)
            cnt = 0
            For k = i To m
                If src(i, 7) = src(k, 7) And src(i, 9) = src(k, 9) Then
                    t = t + CDate(src(k, 6))
                    cnt = cnt + 1
                    src(k, 1) = 0
                End If
            Next
            wsh.Cells(j, 1).Value = cnt
            wsh.Cells(j, 6).Value = Format(t, "hh:mm:ss")
            wsh.Cells(j, 7).Value = src(i, 7)
            wsh.Cells(j, 9).Value = src(i, 9)
            j = j + 1
        End If
    Next
    
    Set wsh = Nothing
End Sub

@Dark_Pingvin · 03.04.2012, 19:08 **[ТС]**

это просто замечательно!!! спасибо, я бы сам за такие сроки просто никак не справился... спасибо огромнейшее, просто не знаю как передать свои эмоции!)))
заранее извиняюсь за назойливость, но при анализе обнаружил такую пакостную производственную особенность нашего контроллера линии... в общем, можно ли как-нибудь перед началом группировки удалить все строки, продолжительность в которым менее 10 секунд. заранее глубоко признателен

@mc-black · 04.04.2012, 09:28

Также сделал работу с Активной рабочей книгой, т.е. макрос как многоразовый можно записать в персональную книгу макросов (personal.xls) и использовать многоразово в ежедневных расчетах.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Option Explicit
 
Sub MkReport()
    Dim i As Long, j As Long, k As Long, m As Long
    Dim src(), wsh As Worksheet, t As Date, cnt As Long
    
    Set wsh = ActiveWorkbook.Worksheets(1)
    
    m = wsh.Cells(4, 1).End(xlDown).Row
    For i = m To 4 Step -1
        If CDate(wsh.Cells(i, 6).Value) <= CDate("0:00:10") Then
            wsh.Cells(i, 6).EntireRow.Delete
        End If
    Next
    
    src = wsh.Range(wsh.Cells(4, 1), wsh.Cells(wsh.Cells(4, 1).End(xlDown).Row, 9)).Value
    m = UBound(src, 1)
    
    j = m + 6
    For i = 1 To m
        If src(i, 1) <> 0 Then
            t = CDate(0)
            cnt = 0
            For k = i To m
                If src(i, 7) = src(k, 7) And src(i, 9) = src(k, 9) Then
                    t = t + CDate(src(k, 6))
                    cnt = cnt + 1
                    src(k, 1) = 0
                End If
            Next
            wsh.Cells(j, 1).Value = cnt
            wsh.Cells(j, 6).Value = Format(t, "hh:mm:ss")
            wsh.Cells(j, 7).Value = src(i, 7)
            wsh.Cells(j, 9).Value = src(i, 9)
            j = j + 1
        End If
    Next
    
    Set wsh = Nothing
End Sub

Можно поинтересоваться, а что за производство такое автоматизированное, что делают установки, если это не гос. тайна?

@Dark_Pingvin · 04.04.2012, 19:58 **[ТС]**

Преогромнейшее спасибо!!! Вы в разы облегчили мне жизнь!!)))
Не секрет) Это сообщения контроллера движения кузовов на окраске автомобилей)

Новые блоги и статьи Все статьи Все блоги /
Ритм жизни kumehtar 27.02.2026 Иногда приходится жить в ритме, где дел становится всё больше, а вовлечения в происходящее — всё меньше. Плотный график не даёт вниманию закрепиться ни на одном событии. Утро начинается с быстрых,. . .	SDL3 для Web (WebAssembly): Сборка библиотек SDL3 и Box2D из исходников с помощью CMake и Emscripten 8Observer8 27.02.2026 Недавно вышла версия SDL 3. 4. 2 библиотеки SDL3. На странице официальной релиза доступны исходники, готовые DLL (для x86, x64, arm64), а также библиотеки для разработки под Android, MinGW и Visual. . .	SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .	Конвертировать закладки radiotray-ng в m3u-плейлист damix 19.02.2026 Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .
Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI Eddy_Em 18.02.2026 Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .	И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»

@Dark_Pingvin 0 / 0 / 0 Регистрация: 03.04.2012 Сообщений: 5
	03.04.2012, 15:21 [ТС]
	к великому сожалению не подходит. начальству нужен скрипт(( 0

@Dark_Pingvin 0 / 0 / 0 Регистрация: 03.04.2012 Сообщений: 5
	03.04.2012, 18:34 [ТС]
	огромнейшее спасибо, это как раз то, что нужно!)) скажите, пожалуйста, а можно этот код научить считать то, что он удалил. то есть, чтобы он писал сколько раз повторялось дублируемое? Заранее признательно благодарен. 0

@Dark_Pingvin 0 / 0 / 0 Регистрация: 03.04.2012 Сообщений: 5
	03.04.2012, 19:08 [ТС]
	это просто замечательно!!! спасибо, я бы сам за такие сроки просто никак не справился... спасибо огромнейшее, просто не знаю как передать свои эмоции!))) заранее извиняюсь за назойливость, но при анализе обнаружил такую пакостную производственную особенность нашего контроллера линии... в общем, можно ли как-нибудь перед началом группировки удалить все строки, продолжительность в которым менее 10 секунд. заранее глубоко признателен 0

@Dark_Pingvin 0 / 0 / 0 Регистрация: 03.04.2012 Сообщений: 5
	04.04.2012, 19:58 [ТС]
	Преогромнейшее спасибо!!! Вы в разы облегчили мне жизнь!!))) Не секрет) Это сообщения контроллера движения кузовов на окраске автомобилей) 0