Доброго времени суток. Понимаю, что тема избита, но все же... совершенству нет предела... :))) Подскажите пути оптимизации макроса по объединению диапазона ячеек построчно с сохранением данных. НУ ПРОСТО ОЧЕНЬ "МЕДЛЕННО" РАБОТАЕТ. (приходится обрабатывать большие массивы данных) собственно сам макрос: ---------------------- [vba]
' само объединение Dim irow As Range, icel As Range, MergeVal As String Application.DisplayAlerts = False For Each irow In Selection.Rows For Each icel In irow.Cells ' тут указываем символ "/" соединения If icel.Value <> "" Then MergeVal = MergeVal & icel.Value & "/" Next icel If MergeVal <> "" Then irow(1).Value = Left(MergeVal, Len(MergeVal) - 1) MergeVal = "" irow.Merge Next irow Application.DisplayAlerts = True End Sub
[/vba] ---------------------- [p.s.] может что-то с цикличностью сделать или как вариант на "С" переписать... у ПЛЕКСа это в разы быстрее работает :((([/p.s.]
Доброго времени суток. Понимаю, что тема избита, но все же... совершенству нет предела... :))) Подскажите пути оптимизации макроса по объединению диапазона ячеек построчно с сохранением данных. НУ ПРОСТО ОЧЕНЬ "МЕДЛЕННО" РАБОТАЕТ. (приходится обрабатывать большие массивы данных) собственно сам макрос: ---------------------- [vba]
' само объединение Dim irow As Range, icel As Range, MergeVal As String Application.DisplayAlerts = False For Each irow In Selection.Rows For Each icel In irow.Cells ' тут указываем символ "/" соединения If icel.Value <> "" Then MergeVal = MergeVal & icel.Value & "/" Next icel If MergeVal <> "" Then irow(1).Value = Left(MergeVal, Len(MergeVal) - 1) MergeVal = "" irow.Merge Next irow Application.DisplayAlerts = True End Sub
[/vba] ---------------------- [p.s.] может что-то с цикличностью сделать или как вариант на "С" переписать... у ПЛЕКСа это в разы быстрее работает :((([/p.s.]Posetitel
Сообщение отредактировал Serge_007 - Вторник, 11.03.2014, 20:24
как вариант (используйте теги "код" - смотрите, как симпатично получается) [vba]
Код
Sub skleivanie22() Dim x, i&, j&, s$ With Range("C2:F12") x = .Value For i = 1 To UBound(x) For j = 1 To UBound(x, 2) If Len(x(i, j)) Then s = s & "/" & x(i, j): x(i, j) = "" End If Next j x(i, 1) = Mid(s, 2): s = "" Next i .Value = x End With End Sub
[/vba]
как вариант (используйте теги "код" - смотрите, как симпатично получается) [vba]
Код
Sub skleivanie22() Dim x, i&, j&, s$ With Range("C2:F12") x = .Value For i = 1 To UBound(x) For j = 1 To UBound(x, 2) If Len(x(i, j)) Then s = s & "/" & x(i, j): x(i, j) = "" End If Next j x(i, 1) = Mid(s, 2): s = "" Next i .Value = x End With End Sub
nilem, ВАУ!!! ФАНТАСТИКА! Скорость мгновенная! Спасибо!!! но возник вопрос: - как объединить содержимое ячеек, если используется не один символ (в данном примере это "/"), а несколько (макрос вставляет знак(и) объединения и перед данными первой ячейки тоже и тут же удаляет его ( |вася|коля| объединяются символами"123", в результате получается |23вася123коля|, надо конечно чтобы было так: |вася123коля| ) и соответственно если объединять без указания символа "", то удаляется первая буква/цифра с данными в первой ячейки т.е. |вася|коля| в результате получается |асяколя|, надо конечно чтобы было так: |васяколя| вот :((
nilem, ВАУ!!! ФАНТАСТИКА! Скорость мгновенная! Спасибо!!! но возник вопрос: - как объединить содержимое ячеек, если используется не один символ (в данном примере это "/"), а несколько (макрос вставляет знак(и) объединения и перед данными первой ячейки тоже и тут же удаляет его ( |вася|коля| объединяются символами"123", в результате получается |23вася123коля|, надо конечно чтобы было так: |вася123коля| ) и соответственно если объединять без указания символа "", то удаляется первая буква/цифра с данными в первой ячейки т.е. |вася|коля| в результате получается |асяколя|, надо конечно чтобы было так: |васяколя| вот :((Posetitel
Sub MergeSelection() Dim Delim As String Dim delim2 As String Dim sMergeStr As String
Delim = "!" delim2 = "@"
Set rCells = Selection With rCells For Each rCell In .Cells If rCell <> "" Then sMergeStr = sMergeStr & Delim & rCell.Text Next rCell sMergeStr = Mid(sMergeStr, 1 + Len(Delim)) sMergeStr = Replace(sMergeStr, Delim, delim2) Application.DisplayAlerts = False .Merge Application.DisplayAlerts = True .Item(1).Value = Replace(sMergeStr, sMergeStr, Delim & sMergeStr & Delim) End With End Sub
[/vba]
[vba]
Код
Sub MergeSelection() Dim Delim As String Dim delim2 As String Dim sMergeStr As String
Delim = "!" delim2 = "@"
Set rCells = Selection With rCells For Each rCell In .Cells If rCell <> "" Then sMergeStr = sMergeStr & Delim & rCell.Text Next rCell sMergeStr = Mid(sMergeStr, 1 + Len(Delim)) sMergeStr = Replace(sMergeStr, Delim, delim2) Application.DisplayAlerts = False .Merge Application.DisplayAlerts = True .Item(1).Value = Replace(sMergeStr, sMergeStr, Delim & sMergeStr & Delim) End With End Sub
krosav4ig, Спасибо за присоединение к дискуссии, но дело в том, что приведенный Вами макрос объединяет ВЕСЬ диапазон в ОДНУ ячейку (и соответственно все данные агрегируются в этой одной бооольшой ячейке, а тут задача объединЯТЬ диапазон ячеек ПОСТРОЧНО. вот :((
krosav4ig, Спасибо за присоединение к дискуссии, но дело в том, что приведенный Вами макрос объединяет ВЕСЬ диапазон в ОДНУ ячейку (и соответственно все данные агрегируются в этой одной бооольшой ячейке, а тут задача объединЯТЬ диапазон ячеек ПОСТРОЧНО. вот :((Posetitel
Posetitel, вот такой получился "картошка-коля, перец-вася" [vba]
Код
Sub ertert() Dim x, i& With Range("A2").CurrentRegion x = .Value For i = 2 To UBound(x) x(i, 2) = x(i, 2) & " " & x(i, 3): x(i, 3) = vbNullString x(i, 5) = x(i, 5) & x(i, 6): x(i, 6) = vbNullString x(i, 8) = x(i, 8) & "123" & x(i, 9): x(i, 9) = vbNullString Next i .Value = x End With End Sub
[/vba]
Posetitel, вот такой получился "картошка-коля, перец-вася" [vba]
Код
Sub ertert() Dim x, i& With Range("A2").CurrentRegion x = .Value For i = 2 To UBound(x) x(i, 2) = x(i, 2) & " " & x(i, 3): x(i, 3) = vbNullString x(i, 5) = x(i, 5) & x(i, 6): x(i, 6) = vbNullString x(i, 8) = x(i, 8) & "123" & x(i, 9): x(i, 9) = vbNullString Next i .Value = x End With End Sub
nilem, ФЕНОМЕНАЛЬНО и ГЕНИАЛЬНО!!! все работает как надо, СПАСИБО!!! Вы ЛУЧШИЙ!!!
P.S. а можно ли таким методом объединять не 2 столбца, а несколько (ну скажем 3 или 5 столбцов/ячеек)? если не сложно, черканите, как будет выглядеть эта строчка? это уже выходит за рамки моей необходимости, но вот что называется "на будущее"... самостоятельно у меня синтаксически не получилось составить строчку Ыыы :)))) P.P.S и подскажите, куда Вам переслать "на шоколадку" :))
nilem, ФЕНОМЕНАЛЬНО и ГЕНИАЛЬНО!!! все работает как надо, СПАСИБО!!! Вы ЛУЧШИЙ!!!
P.S. а можно ли таким методом объединять не 2 столбца, а несколько (ну скажем 3 или 5 столбцов/ячеек)? если не сложно, черканите, как будет выглядеть эта строчка? это уже выходит за рамки моей необходимости, но вот что называется "на будущее"... самостоятельно у меня синтаксически не получилось составить строчку Ыыы :)))) P.P.S и подскажите, куда Вам переслать "на шоколадку" :))Posetitel
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
еще раз большое Спасибо!!!
