Здравствуйте! Умные головы! Прошу Вашей помощи! В таблице инфа размещена таким образом, что наименования фирм находятся в объединенных ячейках, а привязанные к ним номера телефонов в столбце в строках, соответствующим объединенным ячейкам, при этом номеров может быть один, 2 , 4 и т.д. Каким образом можно разместить нужные номера телефонов в одной строке с наименованием фирмы. Все большое спасибо!
Здравствуйте! Умные головы! Прошу Вашей помощи! В таблице инфа размещена таким образом, что наименования фирм находятся в объединенных ячейках, а привязанные к ним номера телефонов в столбце в строках, соответствующим объединенным ячейкам, при этом номеров может быть один, 2 , 4 и т.д. Каким образом можно разместить нужные номера телефонов в одной строке с наименованием фирмы. Все большое спасибо!gunna
Sub Телефоны() Dim L, L1 As Long, S As String Application.ScreenUpdating = False L = Cells(Rows.Count, 5).End(xlUp).Row For I = 2 To L If Cells(I, 4).Value <> "" Then If L1 <> 0 Then Cells(L1, 6).Value = CStr(S) L1 = I If Cells(I, 5).Value <> "" Then S = Cells(I, 5).Value Else: If Cells(I, 5).Value <> "" Then S = S & ", " & Cells(I, 5).Value End If Next I Application.ScreenUpdating = True End Sub
[/vba]
Вроде, работает, но лучше потестируйте upd [vba]
Код
Sub Телефоны() Dim L, L1 As Long, S As String Application.ScreenUpdating = False L = Cells(Rows.Count, 5).End(xlUp).Row For I = 2 To L If Cells(I, 4).Value <> "" Then If L1 <> 0 Then Cells(L1, 6).Value = CStr(S) L1 = I If Cells(I, 5).Value <> "" Then S = Cells(I, 5).Value Else: If Cells(I, 5).Value <> "" Then S = S & ", " & Cells(I, 5).Value End If Next I Application.ScreenUpdating = True End Sub
отлично! все сработало! Я очень признательна Вам! Если еще один нюанс при транспонировании учесть, чтобы эти самые номера попадали в строку, но в разные ячейки. Возможен ли такой вариант?[offtop]
отлично! все сработало! Я очень признательна Вам! Если еще один нюанс при транспонировании учесть, чтобы эти самые номера попадали в строку, но в разные ячейки. Возможен ли такой вариант?[offtop] gunna
Sub Телефоны2() Dim L, L1, C1 As Long, S As String Application.ScreenUpdating = False L = Cells(Rows.Count, 5).End(xlUp).Row For I = 2 To L If Cells(I, 4).Value <> "" Then L1 = I C1 = 0 End If If Cells(I, 5).Value <> "" Then Cells(L1, 6 + C1).Value = CStr(Cells(I, 5).Value) C1 = C1 + 1 End If Next I Application.ScreenUpdating = True End Sub
[/vba]
Попробуйте так: [vba]
Код
Sub Телефоны2() Dim L, L1, C1 As Long, S As String Application.ScreenUpdating = False L = Cells(Rows.Count, 5).End(xlUp).Row For I = 2 To L If Cells(I, 4).Value <> "" Then L1 = I C1 = 0 End If If Cells(I, 5).Value <> "" Then Cells(L1, 6 + C1).Value = CStr(Cells(I, 5).Value) C1 = C1 + 1 End If Next I Application.ScreenUpdating = True End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
