Форум программистов
 
Регистрация на форуме тут, о проблемах пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail, а тут можно восстановить пароль

Купить рекламу на форуме 15-35 тыс рублей в месяц

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

           Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
           И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - https://clck.ru/fCqwP

Закрытая тема
Ваша тема закрыта, почему это могло произойти? Возможно,
Нет наработок или кода, если нужно готовое решение - создайте тему в разделе Фриланс и оплатите работу.
Название темы включает слова - "Помогите", "Нужна помощь", "Срочно", "Пожалуйста".
Название темы слишком короткое или не отражает сути вашего вопроса.
Тема исчерпала себя, помните, один вопрос - одна тема
Прочитайте правила и заново правильно создайте тему.
 
Опции темы Поиск в этой теме
Старый 25.10.2008, 13:14   #1
stbo
Пользователь
 
Регистрация: 09.10.2008
Сообщений: 42
По умолчанию Разединение данных из ячейки ????

Данные находятся внутри одной ячейки и разделены Alt+Enter
Задача разнести автоматически имена по различным ячейкам, при условии что
кол-во имён внутри одной ячейки различно. Очень буду благодарен за помощь
Вложения
Тип файла: rar makro.rar (1.8 Кб, 23 просмотров)
stbo вне форума
Старый 25.10.2008, 13:37   #2
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,852
По умолчанию

Данный код разбивает содержимое выделенных ячеек на части, и вставляет отдельные артикулы в ячейки, расположенные правее обрабатываемой ячейки:

Код:
    For Each ce In Selection.Cells
        CellValue = Trim$(ce.Value): lf2 = vbLf & vbLf
        While InStr(1, CellValue, lf2) > 0: CellValue = Replace(CellValue, lf2, vbLf): Wend
        arr = Split(Trim$(CellValue), vbLf)
        For i = 0 To UBound(arr)
            If Len(arr(i)) > 1 Then ce.Offset(0, i + 1).Value = arr(i)
        Next i
    Next ce
В приложенном файле сначала нажмите кнопку Выделить, а потом кнопку Раскидать по ячейкам
Вложения
Тип файла: rar Twins.rar (15.0 Кб, 33 просмотров)

Последний раз редактировалось EducatedFool; 25.10.2008 в 13:49. Причина: откорректировал код (вспомнил, что в некоторых ячейках попадались двойные vbLF)
EducatedFool вне форума
Старый 25.10.2008, 13:47   #3
stbo
Пользователь
 
Регистрация: 09.10.2008
Сообщений: 42
Хорошо спасибо

Вы меня опять очень выручаете. Большое спасибо. А можно Вас попросить, разместить кнопку "раскидать по ячейкам" в один ряд с предыдущими и добавит обратную кнопку "Соединить". Но в любом случае Вы маг
stbo вне форума
Старый 25.10.2008, 13:53   #4
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,852
По умолчанию

Цитата:
добавит обратную кнопку "Соединить"
Да не проблема

Вот только уточните, при раскидывании по ячейкам в какие ячейки записывать значения (в столбик, строчку, или как-то ещё),
а так же, из какого диапазона ячеек брать артикулы для соединения?

Цитата:
разместить кнопку "раскидать по ячейкам" в один ряд с предыдущими
а разве это сложно? Если сложности с выделением кнопки для перетаскивания (из-за назначенного макроса), то можно выделить её так: сначала кликаем на кнопке правой кнопкой мыши, потом нажимает Escape на клавиатуре (чтобы убрать контекстное меню)
Теперь кнопка выделена, и перетаскивайте её куда угодно (при этом изменяя её размеры)

Последний раз редактировалось EducatedFool; 25.10.2008 в 14:03.
EducatedFool вне форума
Старый 25.10.2008, 14:05   #5
stbo
Пользователь
 
Регистрация: 09.10.2008
Сообщений: 42
Хорошо

да вопрос хороший. технически мне необходимо, чтобы имена размещались в столбик, но это сопряжено с автоматическим добавлением строк. Я просто не знаю насколько это сложная задача? Если это возможно, это будет просто супер.
stbo вне форума
Старый 25.10.2008, 14:28   #6
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,852
По умолчанию

Вот пока вариант с кнопкой соединить.
Сначала нажимаем Выделить, потом Соединить
После кнопки Выделить (перед операцией соединения) понадобится нажимать клавишу Delete, чтобы очистить диапазон.

Цитата:
технически мне необходимо, чтобы имена размещались в столбик, но это сопряжено с автоматическим добавлением строк. Я просто не знаю насколько это сложная задача?
Это несложная задача. Вопрос - как это всё должно выглядеть?
Если я правильно понял, на месте строки с объединённой ячейкой ( в которой, к примеру, 7 артикулов), должно появляться 7 строк, в каждой из которых будет свой артикул. Реализовать это просто, но надо знать, что делать с данными из других столбцов (при преобразовании одной строки в семь) - копировать их в каждую из новых строк, или нет?

И что делать с данными из других столбцов при обратной операции (7 строк преобразуем в одну)? Или эта обратная операция не нужна?

По возможности, прикрепите к сообщению оригинальный файл с подробными комментариями, как всё это доолжно выглядеть до и после обработки.
Вложения
Тип файла: rar Twins.rar (16.7 Кб, 23 просмотров)
EducatedFool вне форума
Старый 25.10.2008, 16:05   #7
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,852
По умолчанию

Вроде сделал так, как надо

Как и прежде, сначала жмём Выделить, потом - Раскидать по строкам

Код:
Sub SplitRows()
    Application.ScreenUpdating = False
    ColumnToSplit = Selection.Columns(1).Column
    For i = Selection.Cells.Count To 1 Step -1
        splitRow Selection.Rows(i).EntireRow, ColumnToSplit
    Next i
    Application.ScreenUpdating = True
End Sub


Sub splitRow(ByVal Row As Range, ByVal ColumnToSplit As Integer)
    Dim Articles As Collection, newRows As Range: Set Articles = GetArticles(Row.Cells(ColumnToSplit))
    If Articles.Count < 2 Then Set Articles = Nothing: Exit Sub

    Row.Offset(1).Resize(Articles.Count).EntireRow.Insert

    Set newRows = Row.Offset(1).Resize(Articles.Count)
    Row.Copy newRows.EntireRow

    For i = 1 To Articles.Count
        newRows.Rows(i).Cells(ColumnToSplit).Value = Articles(i)
    Next i
    newRows.EntireRow.AutoFit
    Row.Delete
End Sub


Function GetArticles(ByRef ce As Range) As Collection
    On Error Resume Next
    Dim tempArticles As New Collection
    arr = Split(Trim$(ce.Value), vbLf)
    For i = 0 To UBound(arr)
        If Len(arr(i)) > 1 Then tempArticles.Add Trim$(arr(i))
    Next i
    Set GetArticles = tempArticles
End Function
Обратите внимание, что если в ячейке были одинаковые артикулы, то все они объединяются в одну строку
( например, если в ячейке было 7 артикулов, из которых 3 одинаковых, то эта строка преобразуется не в 7 строк, а в 5)
Вложения
Тип файла: rar Twins.rar (17.7 Кб, 28 просмотров)

Последний раз редактировалось EducatedFool; 25.10.2008 в 16:10.
EducatedFool вне форума
Старый 26.10.2008, 13:20   #8
stbo
Пользователь
 
Регистрация: 09.10.2008
Сообщений: 42
Хорошо

в последнем файле всё супер, то что надо!!!
А вот соединение, было бы здорово если выделяю диапазон ячеек (маркированием или Strg+левый клик) И нажав на "соединить"в специально выделенной ячейке соединяться артикли в столбик через Ait+Enter между собой.
В любом случае спасибо огромное, вы настолько упрощаете ту рутину, которая просто достала меня. Полный респект и уважуха с моей стороны
stbo вне форума
Старый 26.10.2008, 13:34   #9
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,852
По умолчанию

В ближайшее время сделаю и выложу файл
EducatedFool вне форума
Старый 26.10.2008, 14:14   #10
stbo
Пользователь
 
Регистрация: 09.10.2008
Сообщений: 42
Смех

заранее спасибо
stbo вне форума
Закрытая тема

           Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
           Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
счет цифровых и буквенных данных из ячейки R2D3 Microsoft Office Excel 0 09.10.2008 08:47
Передача данных из одной таблицы в другую, при выборе одной ячейки MickMick Microsoft Office Excel 6 06.10.2008 13:57
Найти первую цифру в данных ячейки.. kra183 Microsoft Office Excel 11 09.05.2008 01:35
Как разделить число и текст в одной ячейки на две ячейки. neboskreb Microsoft Office Excel 2 15.04.2008 19:39