Доброго всем дня. Требуется Ваша помощь! За помощь готов отблагодарить ;). Имеется прайс в excel с несколькими столбцами, необходимо объединить некоторые столбцы в один, но так что бы текст из каждого объединённого столбца начинался с новой строки. Так же хотелось бы что бы он объединял к примеру столбец 1,2,3 со значения 10,20,30 таким образом что бы к нужному столбцу добавлял свой текст и так же начинал с новой строки.
например имеем значения в разных столбцах (разделитель между столбцами запятая): 10,20,30
получаем (всё в одной ячейке, и каждое значение с новой строки + добавленный текст): ширина|10 профиль|20 диаметр|30
Что бы было понятно, прикладываю картинку, а так же сам прайс. - 1 строка как надо сделать, последующие как есть в прайсе на данный момент.
Сейчас приходится: 1) с помощью "поиск/замена" редактировать каждую из колонок что бы добавить дополнительный текст. 2) с помощью макроса объединять столбцы в один
[vba]
Код
Sub MergeToOneCell() Const sDELIM As String = " " 'символ-разделитель Dim rCell As Range Dim sMergeStr As String If TypeName(Selection) <> "Range" Then Exit Sub 'если выделены не ячейки - выходим With Selection For Each rCell In .Cells sMergeStr = sMergeStr & sDELIM & rCell.Text 'собираем текст из ячеек Next rCell Application.DisplayAlerts = False 'отключаем стандартное предупреждение о потере текста .Merge Across:=False 'объединяем ячейки Application.DisplayAlerts = True .Item(1).Value = Mid(sMergeStr, 1 + Len(sDELIM)) 'добавляем к объед.ячейке суммарный текст .WrapText = true End With End Sub
[/vba]
3) опять с помощью "поиск/замена" в получившемся столбце менять пробелы на перенос строки.
Доброго всем дня. Требуется Ваша помощь! За помощь готов отблагодарить ;). Имеется прайс в excel с несколькими столбцами, необходимо объединить некоторые столбцы в один, но так что бы текст из каждого объединённого столбца начинался с новой строки. Так же хотелось бы что бы он объединял к примеру столбец 1,2,3 со значения 10,20,30 таким образом что бы к нужному столбцу добавлял свой текст и так же начинал с новой строки.
например имеем значения в разных столбцах (разделитель между столбцами запятая): 10,20,30
получаем (всё в одной ячейке, и каждое значение с новой строки + добавленный текст): ширина|10 профиль|20 диаметр|30
Что бы было понятно, прикладываю картинку, а так же сам прайс. - 1 строка как надо сделать, последующие как есть в прайсе на данный момент.
Сейчас приходится: 1) с помощью "поиск/замена" редактировать каждую из колонок что бы добавить дополнительный текст. 2) с помощью макроса объединять столбцы в один
[vba]
Код
Sub MergeToOneCell() Const sDELIM As String = " " 'символ-разделитель Dim rCell As Range Dim sMergeStr As String If TypeName(Selection) <> "Range" Then Exit Sub 'если выделены не ячейки - выходим With Selection For Each rCell In .Cells sMergeStr = sMergeStr & sDELIM & rCell.Text 'собираем текст из ячеек Next rCell Application.DisplayAlerts = False 'отключаем стандартное предупреждение о потере текста .Merge Across:=False 'объединяем ячейки Application.DisplayAlerts = True .Item(1).Value = Mid(sMergeStr, 1 + Len(sDELIM)) 'добавляем к объед.ячейке суммарный текст .WrapText = true End With End Sub
[/vba]
3) опять с помощью "поиск/замена" в получившемся столбце менять пробелы на перенос строки.Sappheiros
Sub ertert() Dim x, i&, j&, t$, arr arr = Array(6, "Шины|Ширина|", 7, "Шины|Профиль|", 8, "Шины|Диаметр|", 9, "Шины|Сезонность|", _ 11, "Шины|Шип|", 12, "Шины|Скорость|", 13, "Шины|Нагрузка|") With Range("A1:M" & Cells(Rows.Count, 1).End(xlUp).Row) x = .Value For i = 1 To UBound(x) If InStr(x(i, 6), Chr(10)) = 0 Then For j = 0 To UBound(arr) Step 2 t = t & arr(j + 1) & x(i, arr(j)) & Chr(10) Next j x(i, 6) = Mid(t, 1, Len(t) - 1): t = vbNullString End If Next i .ClearContents: .Resize(UBound(x), 6).Value = x End With End Sub
[/vba]
Привет, Sappheiros как-то так?: [vba]
Код
Sub ertert() Dim x, i&, j&, t$, arr arr = Array(6, "Шины|Ширина|", 7, "Шины|Профиль|", 8, "Шины|Диаметр|", 9, "Шины|Сезонность|", _ 11, "Шины|Шип|", 12, "Шины|Скорость|", 13, "Шины|Нагрузка|") With Range("A1:M" & Cells(Rows.Count, 1).End(xlUp).Row) x = .Value For i = 1 To UBound(x) If InStr(x(i, 6), Chr(10)) = 0 Then For j = 0 To UBound(arr) Step 2 t = t & arr(j + 1) & x(i, arr(j)) & Chr(10) Next j x(i, 6) = Mid(t, 1, Len(t) - 1): t = vbNullString End If Next i .ClearContents: .Resize(UBound(x), 6).Value = x End With End Sub
Я так понимаю что указанные цифры в этой строке, это номера колонок, то есть если колонка сместится, то необходимо будет указать уже другой номер - всё верно? p.s. к сожалению проверить смогу лишь завтра, если всё гуд, то с меня презент
p.p.s. а как можно вырезать артикул в отдельную колонку (первые цифры до пробела в 3 колонке)?
nilem, Огромное спасибо! А подскажите ещё такой момент.
Я так понимаю что указанные цифры в этой строке, это номера колонок, то есть если колонка сместится, то необходимо будет указать уже другой номер - всё верно? p.s. к сожалению проверить смогу лишь завтра, если всё гуд, то с меня презент
p.p.s. а как можно вырезать артикул в отдельную колонку (первые цифры до пробела в 3 колонке)?Sappheiros
Сообщение отредактировал Sappheiros - Четверг, 16.10.2014, 22:24
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
