Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Добавить префикс из значения первой ячейки в несмежных диапазонах
 
#1
09.10.2017 14:52:19
Доброго дня, Планетяне!
В последнее время частенько приходится обрабатывать такие "диапазоны", как на скрине. Помогите с макросом, пожалуйста…
Откопал в закромах макрос на объединение ячеек с сохранением содержимого (оставил в файле-примере), но это не то — тут как-то нужно Selection.Areas перебирать, вроде. Запоминать содержимое первой ячейки, добавлять его, как префикс с пробелом к другим ячейкам текущей зоны, а саму ячейку-источник вместе со строкой целиком удалять.
Зоны через Ctrl выделяю сам - не всегда они, как на скрине, подряд идут
Код объединения ячеек

Изменил название файла-примера. Было некорректное
Изменено: Jack Famous - 09.10.2017 15:09:39
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#2
09.10.2017 15:03:53
Если как в примере - будет трудно. Если как на скрине - будет легко. Кусок, как на скрине в примере покажите. :)
Там строки шерстить заполненные, по пустой правой ячейке определять значение "перфикса". Ячейка не пустая - добавляем запомненный перфикс. Появилась пустая? - перфикс переписываем. А потом циклом снизу вверх удаляем строки с пустыми значениями справа.
Как-то так, навскидку.
Изменено: Пытливый - 09.10.2017 15:04:38
Кому решение нужно - тот пример и рисует.
 
 
 
#3
09.10.2017 15:07:28
Пытливый, а почему в примере сложнее? Я же сам выделю (руками) группы через Ctrl. Если сложности с удалением ячеек-префиксов, то пофиг на них - руками удалю. Главное дописать эти префиксы в остальные ячейки группы, а то долго…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#4
09.10.2017 15:12:36
выделяете раздельные диапазоны вместе или каждый диапазон отдельно?
в выделение всегда первая строка префикс я так понял?
Изменено: V - 09.10.2017 15:13:18
 
 
 
#5
09.10.2017 15:17:17
V, да. В столбце данные идут либо как на скрине, либо как положено — полное наименование в отдельной строке.
Я просматриваю глазами все данные и выделяю через CTRL вот такие области, где каждая первая ячейка области - префикс, а в остальные ячейки этой зоны этот префикс нужно добавить, после чего саму эту первую ячейку удалить вместе со строкой (EntireRow)
Пока так получается только
Изменено: Jack Famous - 09.10.2017 15:17:58
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#6
09.10.2017 15:17:23
Как удалять ненужное допилите сами по своему вкусу
Код
Sub AddPrefix()
Dim I&, J&
For I = 1 To Selection.Areas.Count
    For J = 1 To Selection.Areas(I).Cells.Count
        If J > 1 Then
            Selection.Areas(I).Cells(J) = Selection.Areas(I).Cells(1) & " " & Selection.Areas(I).Cells(J)
        End If
    Next
    Selection.Areas(I).Cells(1).ClearContents
Next
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#7
09.10.2017 15:19:17
Sanja, спасибо большое! кажется я понял принцип по вашему коду!)))) отпишусь сюда…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#8
09.10.2017 15:24:51
Я про скрин писал, поскольку там есть доп.информация в соседних ячейках (или ее там нет), т.е. есть признак, по которому можно зацепиться и обрабатывать ячейки в определенных строках. А в примере - тупо столбец и неясно как программе объяснить (без участия оператора) что есть перфикс, а что есть данные.
Кому решение нужно - тот пример и рисует.
 
 
 
#9
09.10.2017 15:32:54
У меня такой вариант. Перевложил файл
Код
Sub tt()
    Dim d1_ As Range
    Application.ScreenUpdating = 0
    Application.Calculation = xlCalculationManual
    If Selection.Count < 2 Then Exit Sub
    For Each d1_ In Selection.Areas
        co_ = d1_.Count
        If co_ > 1 Then
            rd_ = rd_ & " " & d1_(1).Row
            ar = d1_
            p_ = ar(1, 1)
            For i = 2 To co_
                ar(i, 1) = p_ & " " & ar(i, 1)
            Next i
            d1_ = ar
        End If
    Next d1_
    aru = Split(rd_)
    For j = UBound(aru) To 1 Step -1
        Cells(aru(j), 1).EntireRow.Delete
    Next j
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = 1
    Selection(1).Select
End Sub
Изменено: _Boroda_ - 09.10.2017 15:35:16
Скажи мне, кудесник, любимец ба’гов...
 
 
 
#10
09.10.2017 15:35:30
Пытливый, ну я же написал и в файле-примере и тут — в шапке темы, что сам (руками) выделять буду эти группы. А в каждой такой (мной выделенной) группе первая ячейка и есть префикс. Ориентироваться на соседние не стал, так как никакой надежды на корректность в этих отчётах нет. А в таком полуавтоматическом режиме - самое то. Спасибо вам большое за внимание к теме!
Изменено: Jack Famous - 09.10.2017 15:36:40
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#11
09.10.2017 15:38:00
_Boroda_, ух интересно как  8-0  попробую прогрызть)) спасибо вам большое! Приятно видеть вас на Планете  :)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#12
09.10.2017 15:58:25
Как-то так у меня вышло. Вроде работает. Были заморочки с удалением этих ячеек-префиксов. Union, вроде справился))
Код

По коду от уважаемого модератора с дружественного сайта: вроде более-менее разобрался в основных моментах)) Пока для меня слишком сложен синтаксис, но, думаю, что со временем и до этого дойду  :)
Спасибо всем за внимание к теме!
Изменено: Jack Famous - 09.10.2017 16:22:22
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#13
09.10.2017 22:22:39
Цитата
Jack Famous написал:
По коду от уважаемого модератора с дружественного сайта:
А хто ето? :D
Цитата
Jack Famous написал:
Пока для меня слишком сложен синтаксис
Дык спрашивайте вопросы, там ничего сложного нет, я с удовольствием отвечу ответы. Для хорошего человека не жалко
Скажи мне, кудесник, любимец ба’гов...
 
 
 
#14
10.10.2017 09:57:56
Цитата
_Boroda_ написал:
А хто ето?
ну дак вы же ш))) здравствуйте! Спасибо :)
Вечером пошагово прокомментирую ваш код и спрошу про непонятки  ;)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
Страницы: 1
Читают тему
Наверх