Имеются 2 таблицы для сбора данных об отсутствующих работниках в одну общую. Нужен макрос, который будет выводить ФИО отсутствующего работника рядом со строкой общей таблицы (болезнь, отпуск и т.д.). Пробовал использовать функции ИНДЕКС и ПОИСКПОЗ, но в данном случае выводилось только первое ФИО из диапазона. В VBA разбираюсь довольно плохо, поэтому обращаюсь к Вам за помощью. Файл-пример прикреплен.
Заранее благодарю за помощь.
Доброго времени суток.
Имеются 2 таблицы для сбора данных об отсутствующих работниках в одну общую. Нужен макрос, который будет выводить ФИО отсутствующего работника рядом со строкой общей таблицы (болезнь, отпуск и т.д.). Пробовал использовать функции ИНДЕКС и ПОИСКПОЗ, но в данном случае выводилось только первое ФИО из диапазона. В VBA разбираюсь довольно плохо, поэтому обращаюсь к Вам за помощью. Файл-пример прикреплен.
Sub Äîá() Dim i&, i_n&, j&, j_n&, n&, i2&, i2_n& Dim t() As String For n = 2 To 3 If i_n < Worksheets(n).Cells(Rows.Count, 2).End(xlUp).Row Then i_n = Worksheets(n).Cells(Rows.Count, 2).End(xlUp).Row End If If j_n < Worksheets(n).Cells(1, Columns.Count).End(xlToLeft).Column Then j_n = Worksheets(n).Cells(1, Columns.Count).End(xlToLeft).Column End If ReDim Preserve t(2, i_n, j_n) For i = 1 To i_n For j = 2 To j_n t(n - 1, i, j) = Worksheets(n).Cells(i, j) Next j Next i Next n i2_n = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row Worksheets(1).Cells(1, 4).Resize(i2_n, 6).Clear For i2 = 5 To 8 For n = 2 To 3 For j = 1 To j_n If t(n - 1, 1, j) = Worksheets(1).Cells(i2, 2) Then For i = 1 To i_n If t(n - 1, i, j) = "1" Then If Worksheets(1).Cells(i2, 4) <> "" Then Worksheets(1).Cells(i2, 4) = Worksheets(1).Cells(i2, 4) & ", " & t(n - 1, i, 2) Else Worksheets(1).Cells(i2, 4) = t(n - 1, i, 2) End If End If Next i End If Next j Next n Next i2 End Sub
[/vba] Поскольку макрос ищет по названиям столбцов, то на Общей странице и на остальных, они должны быть одинаковы.
Hoxton, Такой попробуйте [vba]
Код
Sub Äîá() Dim i&, i_n&, j&, j_n&, n&, i2&, i2_n& Dim t() As String For n = 2 To 3 If i_n < Worksheets(n).Cells(Rows.Count, 2).End(xlUp).Row Then i_n = Worksheets(n).Cells(Rows.Count, 2).End(xlUp).Row End If If j_n < Worksheets(n).Cells(1, Columns.Count).End(xlToLeft).Column Then j_n = Worksheets(n).Cells(1, Columns.Count).End(xlToLeft).Column End If ReDim Preserve t(2, i_n, j_n) For i = 1 To i_n For j = 2 To j_n t(n - 1, i, j) = Worksheets(n).Cells(i, j) Next j Next i Next n i2_n = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row Worksheets(1).Cells(1, 4).Resize(i2_n, 6).Clear For i2 = 5 To 8 For n = 2 To 3 For j = 1 To j_n If t(n - 1, 1, j) = Worksheets(1).Cells(i2, 2) Then For i = 1 To i_n If t(n - 1, i, j) = "1" Then If Worksheets(1).Cells(i2, 4) <> "" Then Worksheets(1).Cells(i2, 4) = Worksheets(1).Cells(i2, 4) & ", " & t(n - 1, i, 2) Else Worksheets(1).Cells(i2, 4) = t(n - 1, i, 2) End If End If Next i End If Next j Next n Next i2 End Sub
[/vba] Поскольку макрос ищет по названиям столбцов, то на Общей странице и на остальных, они должны быть одинаковы.Roman777