Страницы: 1
RSS
Перенос текста на новую строку и добавление ячеек
 
Добрый день. Возможно ли реализовать формулой следующее или нужно писать макрос?
В строке указано несколько значений через запятую. Нужно для каждого значения создать новую ячейку и перенести каждое значение в каждую ячейку.
Как правильно объяснить суть задачи не знаю, поэтому прикладываю файл с примером. Вверху файла исходная задача, внизу то, что должно получиться.

Была идея использовать Ворд, в котором сначала перенести значения в ручную. Но тогда нужно будет потратить много времени на присваивание значениям правильной группы. Поэтому данный метод не подходит(((
 
Посмотрите
http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=80679
 
Цитата
disman написал: Возможно ли реализовать формулой
Возможно, но очень-очень это хлопотно. Да и потом сами не разберётесь, что и куда. Лучший вариант, если всё-таки макросов боитесь - текст по столбцам разбить и уже значительно проще и формула будет.  
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
Kuzmich, спасибо, это точно нужно. Но есть один момент. Макрос не работает с текстом. В той теме был пример с числами, а у меня все ячейки текстовые. И макрос либо вообще ничего не делает, либо выдает ошибку. В коде я не особо разбираюсь, пытался менять тип данных на String. Не знаю насколько это правильно, но в любом случае не заработало.
Что нужно исправить? У меня все 3 ячейки текстовые.
Ошибки вылезают либо Overflow, либо type mismatch
Изменено: disman - 02.09.2016 18:14:18
 
Цитата
Владимир написал:
Возможно, но очень-очень это хлопотно. Да и потом сами не разберётесь, что и куда. Лучший вариант, если всё-таки макросов боитесь - текст по столбцам разбить и уже значительно проще и формула будет.
Макросов не боюсь, просто не умею кодить))
 
Цитата
Что нужно исправить? У меня все 3 ячейки текстовые.
Код
Sub Resultat()
Dim i As Long
Dim j As Integer
Dim iLastRow As Long
Dim Kod1 As Integer
Dim Kod2
Dim iGruppa As String
  iLastRow = [B2].End(xlDown).Row
     For i = iLastRow To 3 Step -1
       If InStr(1, Cells(i, 4), ",") <> 0 Then
         Kod1 = Cells(i, 2)
         Kod2 = Split(Cells(i, 4), ",")
         iGruppa = Cells(i, 3)
         For j = 0 To UBound(Kod2)
           Rows(i + j).Insert
           Cells(i + j, 2) = Kod1
           Cells(i + j, 4) = Kod2(j)
           Cells(i + j, 3) = iGruppa
         Next
           Rows(i + j).Delete
       End If
     Next
End Sub
 
Добрый день! Помогите, пожалуйста, с подобной задачей, но немного сложнее.
Во вложении пример, вкладка было-стало.

Задача подобна:
нужно разделить стоблец D по словам, продублировав данные из остальные столбцах в строке.

Я применила пример макроса из этой темы, исправив в функции InStr "," на " ", посчитав, что в моем случае резделителем нужно считать пробел.
Данные из столблцов E,F,G,H подтянулись только в 5 строке, в 1-4 не подтянулись.
И текст разделилися, но не по словам, как нужно, а кусочно.

VBA совсем не понимаю.
Сейчас начала разбираться в синтаксисе, как присваиватся переменные Dim, про функции InStr и так далее.

Но этого явно недостаточно, чтоб дописать то, что мне нужно.

Буду благодарна за помощь.
 
А в этой строке Вы поменяли запятую на пробел? Kod2 = Split(Cells(i, 4), " ")
 
Цитата
Ник Никитич написал:
А в этой строке Вы поменяли запятую на пробел? Kod2 = Split(Cells(i, 4), " ")
Да, но проблема оказалась в несохранениия Macro Enabled Workbook* формате.

Слова разделились, спасибо Kuzmich, за макрос.
Вопрос: как можно усовершенствать макрос, чтоб он копировал не только столбцы B/D но и E,,,H и далее?
Изменено: maria11111 - 07.03.2017 14:10:12
 
Вот так? Поменял запятые и добавил End Sub
Код
Sub Resultat()
Dim i As Long
Dim j As Integer
Dim iLastRow As Long
Dim Kod1 As Integer
Dim Kod2
Dim iGruppa As String
  iLastRow = [B2].End(xlDown).Row
     For i = iLastRow To 3 Step -1
       If InStr(1, Cells(i, 4), " ") <> 0 Then
         Kod1 = Cells(i, 2)
         Kod2 = Split(Cells(i, 4), " ")
         iGruppa = Cells(i, 3)
         Set rng = Range(Cells(i, 5), Cells(i, 8)) 'добавил
         For j = 0 To UBound(Kod2)
           Rows(i + j).Insert
           Cells(i + j, 2) = Kod1
           Cells(i + j, 4) = Kod2(j)
           Cells(i + j, 3) = iGruppa
           Range(Cells(i + j, 5), Cells(i + j, 8)).Value = rng.Value 'добавил
         Next
           Rows(i + j).Delete
       End If
     Next i
End Sub
Изменено: Ник Никитич - 07.03.2017 15:03:16
 
Да, спасибо большое!
Исправила еще раз запятые на пробелы, и End Sub.
 
Цитата
Ник Никитич написал:
Вот так? Поменял запятые и добавил End Sub
Я тоже поменяла.
Но если добавить больше текста (больше строк) выдает ошибку.
Страницы: 1
Наверх