Добрый день и удачной пятницы. Прошу подсказать решение проблемы. На форуме пояснили что решить ее с помощью формул нет возможности. Нашел аналогичную тему , но не могу пристроить к своему файлу www.excelworld.ru/forum/2-12352-1 Суть проблемы в следующем: в листе "Общий график платежей" (лист3) вносятся все монтажи с указанием клиента и вида работ. Потом назначается ответственная бригада за монтаж. Существует еще 2 листа Бригада 1 и Бригада 2. Задача в следующем, в один день может быть несколько монтажей у одной и той же бригады, нужно чтобы клиенты которых бригада устанавливает сцеплялись и прописывались в строку с датой в нужный лист, т.е. бригада1 в лист бригада 1 и т.д.
Добрый день и удачной пятницы. Прошу подсказать решение проблемы. На форуме пояснили что решить ее с помощью формул нет возможности. Нашел аналогичную тему , но не могу пристроить к своему файлу www.excelworld.ru/forum/2-12352-1 Суть проблемы в следующем: в листе "Общий график платежей" (лист3) вносятся все монтажи с указанием клиента и вида работ. Потом назначается ответственная бригада за монтаж. Существует еще 2 листа Бригада 1 и Бригада 2. Задача в следующем, в один день может быть несколько монтажей у одной и той же бригады, нужно чтобы клиенты которых бригада устанавливает сцеплялись и прописывались в строку с датой в нужный лист, т.е. бригада1 в лист бригада 1 и т.д.VIDEO56
Private Sub Worksheet_Change(ByVal Target As Range) Dim c&, r&, i&, n&, m$, s$, d(), v() c = Target.Column Select Case c Case 2, 3, 17 r = Target.Row If r > 2 Then r = r - 2 v = Cells(3, 2).Resize(Cells(Rows.Count, 17).End(xlUp).Row - 2, 16).Value On Error Resume Next s = v(r, 16) With Worksheets(s) n = v(r, 1) d = .UsedRange.Columns(2).Value For i = 1 To UBound(d) If d(i, 1) = n Then For r = r - 1 To 1 Step -1 If v(r, 1) <> n Then Exit For Next r = r + 1 For r = r To UBound(v) If v(r, 1) <> n Then Exit For If v(r, 16) = s Then m = m & ", " & v(r, 2) Next If Len(m) Then .Cells(i, 3) = Mid$(m, 3) Exit For End If Next End With End If End Select End Sub
[/vba]
(при добавлении/изменении данных на листе "Общий график монтажей", они автоматически прописываются на соответствующем листе "Бригада N", а чтобы данные корректно удалялись с листов "Бригада N", нужно чтобы информация из ячеек "Дата монтажа" и "Монтажная бригада" удалялась последней, т.к. по ней происходит выбор соответствующего листа и соответствующей даты на этом листе)
Добрый день! Посмотрите, как вариант.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim c&, r&, i&, n&, m$, s$, d(), v() c = Target.Column Select Case c Case 2, 3, 17 r = Target.Row If r > 2 Then r = r - 2 v = Cells(3, 2).Resize(Cells(Rows.Count, 17).End(xlUp).Row - 2, 16).Value On Error Resume Next s = v(r, 16) With Worksheets(s) n = v(r, 1) d = .UsedRange.Columns(2).Value For i = 1 To UBound(d) If d(i, 1) = n Then For r = r - 1 To 1 Step -1 If v(r, 1) <> n Then Exit For Next r = r + 1 For r = r To UBound(v) If v(r, 1) <> n Then Exit For If v(r, 16) = s Then m = m & ", " & v(r, 2) Next If Len(m) Then .Cells(i, 3) = Mid$(m, 3) Exit For End If Next End With End If End Select End Sub
[/vba]
(при добавлении/изменении данных на листе "Общий график монтажей", они автоматически прописываются на соответствующем листе "Бригада N", а чтобы данные корректно удалялись с листов "Бригада N", нужно чтобы информация из ячеек "Дата монтажа" и "Монтажная бригада" удалялась последней, т.к. по ней происходит выбор соответствующего листа и соответствующей даты на этом листе)KSV