Я перечитала кучу разной информации, советов и форумов, бьюсь уже несколько недель, но так и не смогла найти совет, который бы подошел к моему заданию. Вроде бы все очень близко, но не дает нужный мне результат. Решилась задать вопрос на форуме, может быть, кто-нибудь найдет время и сможет мне помочь с этим заданием.
Итак, задание: Есть таблица их четырех столбцов и нескольких строк. Таких таблиц много: несколько штук на нескольких листах. Привожу пример для одной.
Необходимо объединить все ячейки данной таблицы в одну ячейку. Для этого я нашла макрос в интернете, и он прекрасно справился с заданием.
Но дальше начинаются проблемы. Необходимо, чтобы каждая новая строчка начиналась с нового абзаца. У меня получается, что с новой строчки начинается каждая сгруппированная ячейка, либо, наоборот, склеиваются все вместе без абзацев, а нужно, чтобы начиналась лишь часть текста (построчно). А также, нужно, чтобы если в столбце "В" в какой-нибудь строчке не был введен текст - то вся строчка не добавлялась к объединению.
Единственный рабочий вариант, что я нашла, это объединение построчно и накладывание на нее доп условий. Но тогда макрос становится просто огромным - почти, как прописывать формулы вручную.
Во вложении файл с примером таблицы, которую нужно объединить в одну ячейку, а также в ячейке А11 (что получается), а в С11 (как должно выгладить в итоге).
Может быть, кто-нибудь смог бы найти время и помочь мне написать "красивый" макрос, который бы удовлетворял всем условиям задания.
Заранее большое спасибо!
Доброй всем ночи!
Помогите, пож-та, разобраться с одним макросом.
Я перечитала кучу разной информации, советов и форумов, бьюсь уже несколько недель, но так и не смогла найти совет, который бы подошел к моему заданию. Вроде бы все очень близко, но не дает нужный мне результат. Решилась задать вопрос на форуме, может быть, кто-нибудь найдет время и сможет мне помочь с этим заданием.
Итак, задание: Есть таблица их четырех столбцов и нескольких строк. Таких таблиц много: несколько штук на нескольких листах. Привожу пример для одной.
Необходимо объединить все ячейки данной таблицы в одну ячейку. Для этого я нашла макрос в интернете, и он прекрасно справился с заданием.
Но дальше начинаются проблемы. Необходимо, чтобы каждая новая строчка начиналась с нового абзаца. У меня получается, что с новой строчки начинается каждая сгруппированная ячейка, либо, наоборот, склеиваются все вместе без абзацев, а нужно, чтобы начиналась лишь часть текста (построчно). А также, нужно, чтобы если в столбце "В" в какой-нибудь строчке не был введен текст - то вся строчка не добавлялась к объединению.
Единственный рабочий вариант, что я нашла, это объединение построчно и накладывание на нее доп условий. Но тогда макрос становится просто огромным - почти, как прописывать формулы вручную.
Во вложении файл с примером таблицы, которую нужно объединить в одну ячейку, а также в ячейке А11 (что получается), а в С11 (как должно выгладить в итоге).
Может быть, кто-нибудь смог бы найти время и помочь мне написать "красивый" макрос, который бы удовлетворял всем условиям задания.
Не знаю, насколько красивый получился - просто тупо в лоб собираем по прядку [vba]
Код
Sub Macro2() r0_ = 1 r1_ = Range("A" & Rows.Count).End(xlUp).Row For i = r0_ To r1_ If Range("B" & i) <> "" Then For j = 1 To 4 d_ = IIf(j = 4, Chr(10), " ") n_ = n_ & Cells(i, j) & d_ Next j End If Next i n_ = Left(n_, Len(n_) - 1) Range("D11") = n_ End Sub
[/vba]
Я бы сделал функцией пользователя лучше. [vba]
Код
Function sbor(diap As Range) r0_ = diap.Row r1_ = r0_ + diap.Rows.Count - 1 c0_ = diap.Column c1_ = c0_ + diap.Columns.Count For i = r0_ To r1_ If Cells(i, c0_ + 1) <> "" Then For j = c0_ To c1_ d_ = IIf(j = c1_, Chr(10), " ") n_ = n_ & Cells(i, j) & d_ Next j End If Next i n_ = Left(n_, Len(n_) - 1) sbor = n_ End Function
[/vba] В файле оранжевое - макросом, серое ЮДФ-кой
Не знаю, насколько красивый получился - просто тупо в лоб собираем по прядку [vba]
Код
Sub Macro2() r0_ = 1 r1_ = Range("A" & Rows.Count).End(xlUp).Row For i = r0_ To r1_ If Range("B" & i) <> "" Then For j = 1 To 4 d_ = IIf(j = 4, Chr(10), " ") n_ = n_ & Cells(i, j) & d_ Next j End If Next i n_ = Left(n_, Len(n_) - 1) Range("D11") = n_ End Sub
[/vba]
Я бы сделал функцией пользователя лучше. [vba]
Код
Function sbor(diap As Range) r0_ = diap.Row r1_ = r0_ + diap.Rows.Count - 1 c0_ = diap.Column c1_ = c0_ + diap.Columns.Count For i = r0_ To r1_ If Cells(i, c0_ + 1) <> "" Then For j = c0_ To c1_ d_ = IIf(j = c1_, Chr(10), " ") n_ = n_ & Cells(i, j) & d_ Next j End If Next i n_ = Left(n_, Len(n_) - 1) sbor = n_ End Function
[/vba] В файле оранжевое - макросом, серое ЮДФ-кой_Boroda_
А можно еще один вопросик? Как сделать так, чтобы если в столбце "B" ни одна ячейка не заполнена, макрос выдавал бы просто пустое место. Сейчас он выдает ошибку. [vba]
Код
Sub Macro2() r0_ = 1 r1_ = Range("A" & Rows.Count).End(xlUp).Row For i = r0_ To r1_ If Range("B" & i) <> "" Then For j = 1 To 4 d_ = IIf(j = 4, Chr(10), " ") n_ = n_ & Cells(i, j) & d_ Next j 'Я прописала вот такое условие: Else For j = 1 To 4 d_ = IIf(j = 4, Chr(10), "") n_ = n_ & d_ (или же просто n_=n_ & " ") Next j '------------------------- End If Next i n_ = Left(n_, Len(n_) - 1) Range("D11") = n_ End Sub
[/vba]
Но, если не заполнены только несколько строчек, то образуется пустой абзац ( или же просто пробел, если меняю "d_" просто на " "). А мне бы хотелось, что пустое место образовывалось только лишь в одном случае, когда пустые все строчки, а если какая-то одна или несколько, то он просто их не учитывал, как в изначальном макросе.
Пробовала прописать по аналогии с аругментом d_, но что-то ерунда какая-то вышла.
Буду очень очень благодарна за помощь!
Заранее спасибо!
[moder]Коды нужно оформлять тегами (кнопка #)! Поправила за Вас[/moder]
_Boroda_, добрый день!
А можно еще один вопросик? Как сделать так, чтобы если в столбце "B" ни одна ячейка не заполнена, макрос выдавал бы просто пустое место. Сейчас он выдает ошибку. [vba]
Код
Sub Macro2() r0_ = 1 r1_ = Range("A" & Rows.Count).End(xlUp).Row For i = r0_ To r1_ If Range("B" & i) <> "" Then For j = 1 To 4 d_ = IIf(j = 4, Chr(10), " ") n_ = n_ & Cells(i, j) & d_ Next j 'Я прописала вот такое условие: Else For j = 1 To 4 d_ = IIf(j = 4, Chr(10), "") n_ = n_ & d_ (или же просто n_=n_ & " ") Next j '------------------------- End If Next i n_ = Left(n_, Len(n_) - 1) Range("D11") = n_ End Sub
[/vba]
Но, если не заполнены только несколько строчек, то образуется пустой абзац ( или же просто пробел, если меняю "d_" просто на " "). А мне бы хотелось, что пустое место образовывалось только лишь в одном случае, когда пустые все строчки, а если какая-то одна или несколько, то он просто их не учитывал, как в изначальном макросе.
Пробовала прописать по аналогии с аругментом d_, но что-то ерунда какая-то вышла.
Буду очень очень благодарна за помощь!
Заранее спасибо!
[moder]Коды нужно оформлять тегами (кнопка #)! Поправила за Вас[/moder]Mirabella
Сообщение отредактировал Mirabella - Понедельник, 09.11.2015, 16:37
Я пробовала так прописать, но макрос все равно выдает ошибку, потому и пришлось прописать условие с пустым местом. Получается, что если все ячейки в столбце "В" пустые, то n_ вообще не существует и он начинает выдавать ошибку.
Может быть, я что-то неправильно понимаю, буду очень благодарна за разъяснение. Во вложении приложила файл с проверкой n_ внизу. Оставшийся код без изменения.
Спасибо!
Manyasha, добрый день!
Я пробовала так прописать, но макрос все равно выдает ошибку, потому и пришлось прописать условие с пустым местом. Получается, что если все ячейки в столбце "В" пустые, то n_ вообще не существует и он начинает выдавать ошибку.
Может быть, я что-то неправильно понимаю, буду очень благодарна за разъяснение. Во вложении приложила файл с проверкой n_ внизу. Оставшийся код без изменения.
Mirabella, смотрите, Ваши 2 последние строчки до моей поправки: [vba]
Код
n_ = Left(n_, Len(n_) - 1) Range("D11") = n_
[/vba] если столбец В пустой, переменная n_ пустая (Empty), функция Len(n_) - возвращает длину подаваемой строки, длина пустой строки = 0. Потом, Вы от этой длины вычитаете 1, получается 0-1=-1. Left - функция аналогичная функции листа ЛЕВСИМВ, т.е. Вы пытаетесь взять у строки -1 левый символ - такого не может быть, поэтому возникает ошибка.
Я Вам предлагаю проверить, не пустая ли n_, и убирать последний символ, только в том случае, если длина строки n_>0.
Теперь смотрите, что Вы написали : [vba]
Код
n_ = Left(n_, Len(n_) - 1)'убираем последний символ Range("D11") = n_'выводим строку в D11
If n_ <> "" Then n = Left(n_, Len(n_) - 1)'убираем еще 1 последний символ, если n_ не является пустой Range("D11") = n_'выводим в D11
[/vba] Даже при отсутствии ошибок, у Вас будет неверный результат.
Оставьте только строчки с проверкой.
Mirabella, смотрите, Ваши 2 последние строчки до моей поправки: [vba]
Код
n_ = Left(n_, Len(n_) - 1) Range("D11") = n_
[/vba] если столбец В пустой, переменная n_ пустая (Empty), функция Len(n_) - возвращает длину подаваемой строки, длина пустой строки = 0. Потом, Вы от этой длины вычитаете 1, получается 0-1=-1. Left - функция аналогичная функции листа ЛЕВСИМВ, т.е. Вы пытаетесь взять у строки -1 левый символ - такого не может быть, поэтому возникает ошибка.
Я Вам предлагаю проверить, не пустая ли n_, и убирать последний символ, только в том случае, если длина строки n_>0.
Теперь смотрите, что Вы написали : [vba]
Код
n_ = Left(n_, Len(n_) - 1)'убираем последний символ Range("D11") = n_'выводим строку в D11
If n_ <> "" Then n = Left(n_, Len(n_) - 1)'убираем еще 1 последний символ, если n_ не является пустой Range("D11") = n_'выводим в D11
[/vba] Даже при отсутствии ошибок, у Вас будет неверный результат.
Теперь макрос воообще оставляет ячейку нетронутой, в случае, если все ячейки пустые. Прописала макрос на очистку перед этим, чтобы затирал старые данные, а то он сохраняет старые, если новые не появились.
Очень очень благодарна за помощь и разъяснения!
Manyasha,
Спасибо огромное!
Теперь макрос воообще оставляет ячейку нетронутой, в случае, если все ячейки пустые. Прописала макрос на очистку перед этим, чтобы затирал старые данные, а то он сохраняет старые, если новые не появились.
Очень очень благодарна за помощь и разъяснения! Mirabella
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
:
