ReSQL.ru
     
powered by simpleCommunicator - 2.0.59     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Макрос для объединения ячеек
25 сообщений из 56, страница 2 из 3
  2  все
Макрос для объединения ячеек
    #34611991
White Owl
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
White Owl
Участник
Deggasad KL (XL)
Конечно, но с крооооошечной оговоркой: этот цикл написан в C, а не VBA ;-)Это хорошо или плохо?это быстрее
...
Рейтинг: 0 / 0
21.06.2007, 18:23
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #34612065
KL (XL)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
KL (XL)
Участник
White Owl Deggasad KL (XL)
Конечно, но с крооооошечной оговоркой: этот цикл написан в C, а не VBA ;-)Это хорошо или плохо?это быстрее

Быстрее - это просто не то слово :-)

KL
[MVP - Microsoft Excel]
...
Рейтинг: 0 / 0
21.06.2007, 18:58
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #34612070
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
KL (XL) White Owl Deggasad KL (XL)
Конечно, но с крооооошечной оговоркой: этот цикл написан в C, а не VBA ;-)Это хорошо или плохо?это быстрее

Быстрее - это просто не то слово :-)

KL
[MVP - Microsoft Excel]

Ну я в этом дилетант
...
Рейтинг: 0 / 0
21.06.2007, 18:59
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #34848099
AlexFred
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AlexFred
Гость
Уважаемые!
Не могли бы вы помочь, программа работает великолепно.
Единственное, нельзя бы было усовершенствовать программу, чтобы ячейки объединялись на одной странице (не Листе), а со следующей страницы начиналось объединение заново.
Заранее благодарен =)
...
Рейтинг: 0 / 0
04.10.2007, 21:56
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #34848933
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Так если сходу переделать код vbapro , то см. ниже...
Можно оптимизировать по скорости если это критично, но нужно время...

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
Sub test2()
Dim RowIndex As Long
Dim StartRow As Long
Dim ColumnToMerge As Long
Dim countHPageBreak As Long
Dim hPB As HPageBreak
Dim pageLastRow() As Variant
Dim i As Long, ihPB As Long
    
    StartRow =  2  ' с какой строки начинать
    ColumnToMerge =  2  ' в какой колонке объединять

    countHPageBreak = ActiveSheet.HPageBreaks.Count
    
    ReDim pageLastRow(countHPageBreak) As Variant
    
    i =  0 
    For Each hPB In ActiveSheet.HPageBreaks
     pageLastRow(i) = hPB.Location.Row -  1 
     i = i +  1 
    Next hPB
    pageLastRow(countHPageBreak) = Cells(Rows.Count, ColumnToMerge).End(xlUp).Row
    
    
    
    Application.DisplayAlerts = False

    For ihPB =  0  To countHPageBreak
        
        For RowIndex = StartRow +  1  To pageLastRow(ihPB)
            With Cells(RowIndex, ColumnToMerge)
                If .Value = .Offset(- 1 ,  0 ).MergeArea.Cells( 1 ).Value Then
                    Range(Cells(RowIndex, ColumnToMerge), .Offset(- 1 ,  0 )).Merge
                End If
            End With
        Next RowIndex
        
        StartRow = pageLastRow(ihPB) +  1 
    Next ihPB

    Application.DisplayAlerts = True
    
End Sub
...
Рейтинг: 0 / 0
05.10.2007, 11:13
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #34849652
AlexFred
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AlexFred
Гость
DeggasadТак если сходу переделать код vbapro , то см. ниже...
Можно оптимизировать по скорости если это критично, но нужно время...


Супер! Я думал это вообще нереально сделать =)
Скорость выполнения, тут как раз не совсем важный фактор. Важен результат.
Единственная просьба, узвеняюсь за надоедливость, если это возможно. Ещё небольшое дополнение.
Если проводить объединение уже во втором столбце, то не учитывается, результаты объединения в первом, а очень бы хотелось, так же с учетом разбиения на страницы :mol: Если это возможно

Поясню

исходные данные
|1|2|3
|1|2|3
|1|2|5
|1|2|3
|1|2|7
|1|2|3
|2|2|9
|2|2|3

результат
исходные данные
|1|2|3
| | |3
| | |5
| | |3
| | |7
| | |3
|2| 2 |9
| |2|3

Иначе, 2-й стобец превращается в единое целое на странице
...
Рейтинг: 0 / 0
05.10.2007, 13:22
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #34849927
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
Sub test()
' объединяет ячейки содинаковыми значениями на странице в указанном столбце
Dim RowIndex As Long
Dim StartRow As Long
Dim LastRow As Long
Dim ColumnToMerge As Long
Dim countHPageBreak As Long
Dim hPB As HPageBreak
Dim pageLastRow() As Variant
Dim i As Long, ihPB As Long
Dim flag As Boolean
    
    
    StartRow =  2  ' с какой строки начинать
    ColumnToMerge =  2  ' в какой колонке объединять
    flag = True  ' учитывать ли значения слева False - нет, True - да

    countHPageBreak = ActiveSheet.HPageBreaks.Count
    
    ReDim pageLastRow(countHPageBreak) As Variant
    
    i =  0 
    For Each hPB In ActiveSheet.HPageBreaks
     pageLastRow(i) = hPB.Location.Row -  1 
     i = i +  1 
    Next hPB
    pageLastRow(countHPageBreak) = Cells(Rows.Count, ColumnToMerge).End(xlUp).Row
    
    
    
    Application.DisplayAlerts = False

    For ihPB =  0  To countHPageBreak
        
        For RowIndex = StartRow +  1  To pageLastRow(ihPB)
            
            With Cells(RowIndex, ColumnToMerge)
                
                If .Value = .Offset(- 1 ,  0 ).MergeArea.Cells( 1 ).Value Then
                  If flag Then
                     If .Offset( 0 , - 1 ).MergeArea( 1 ).Value = .Offset(- 1 , - 1 ).MergeArea( 1 ).Value Then  '.Offset(0, -1).MergeArea.Address <> .Offset(-1, -1).MergeArea.Address Then
                         Range(Cells(RowIndex, ColumnToMerge), .Offset(- 1 ,  0 )).Merge
                     End If
                   Else
                  Range(Cells(RowIndex, ColumnToMerge), .Offset(- 1 ,  0 )).Merge
                  End If
                End If
           
            End With
            
            
        Next RowIndex
        
        StartRow = pageLastRow(ihPB) +  1 
    Next ihPB

    Application.DisplayAlerts = True

End Sub
...
Рейтинг: 0 / 0
05.10.2007, 14:11
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #34850338
AlexFred
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AlexFred
Гость
Спасибо!

Единственно, если проводить объединение, относительно 3-го столбца, то почему-то он не реагирует на параметр флаг. Т.е. получается так, что в третьем столбце обединяются все ячейки =(
...
Рейтинг: 0 / 0
05.10.2007, 15:38
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #34850412
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
AlexFredСпасибо!

Единственно, если проводить объединение, относительно 3-го столбца, то почему-то он не реагирует на параметр флаг. Т.е. получается так, что в третьем столбце обединяются все ячейки =(

Если ячейки во втором столбце уже объединены, то

вместо
Код: plaintext
If .Offset( 0 , - 1 ).MergeArea( 1 ).Value = .Offset(- 1 , - 1 ).MergeArea( 1 ).Value Then

можно использовать условие

Код: plaintext
If .Offset( 0 , - 1 ).MergeArea.Address = .Offset(- 1 , - 1 ).MergeArea.Address Then

оно есть в предыдущем посте в примечании
...
Рейтинг: 0 / 0
05.10.2007, 15:56
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #34850483
AlexFred
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AlexFred
Гость
Семен Семеныч...
Отлично. Очень нужная вещь получилась, причем,уверен, не только мне 8)
...
Рейтинг: 0 / 0
05.10.2007, 16:13
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #35124783
AlexFred
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AlexFred
Гость
2 Deggasad

Доброе время суток. Не могли бы вы ещё раз оказать помощь.
По непонятной причине стала выскакивать ошибка

Microsoft Visual Basic
Run-time error '9'
Subscript out of range

1. Чем это может быть вызвано?
2. Как с этим бороться?

Заранее благодарен.
...
Рейтинг: 0 / 0
11.02.2008, 16:52
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #35124898
AlexFred
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AlexFred
Гость
Опытным путем выяснилось, что "беда" (см. пост выше) начинается где-то, если масив превышает 7-8 тыс. записей
...
Рейтинг: 0 / 0
11.02.2008, 17:24
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #35127123
AlexFred
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AlexFred
Гость
И, если возможно, в алгоритме убрать анализ окончания страницы, т.е. чтобы объединение ячеек шло без учёта страницы
...
Рейтинг: 0 / 0
12.02.2008, 14:44
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #35127652
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
1) Насчёт ошибки: с этой разметкой страниц постоянного заморочки. Конкретно данный случай должен лечится переходом в режим разметки страницы.
Т.е. вместо
Код: plaintext
1.
2.
3.
4.
5.
    i =  0 
    For Each hPB In ActiveSheet.HPageBreaks
     pageLastRow(i) = hPB.Location.Row -  1 
     i = i +  1 
    Next hPB
    pageLastRow(countHPageBreak) = Cells(Rows.Count, ColumnToMerge).End(xlUp).Row

Пишем

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
  ActiveWindow.View = xlPageBreakPreview
    i =  0 
    For Each hPB In ActiveSheet.HPageBreaks
     pageLastRow(i) = hPB.Location.Row -  1 
     i = i +  1 
    Next hPB
    pageLastRow(countHPageBreak) = Cells(Rows.Count, ColumnToMerge).End(xlUp).Row
  ActiveWindow.View = xlNormalView

А насчёт убрать анализ окончания страницы, то примеры были ранее. В этой задачке как раз и был смысл с учётом страниц.
...
Рейтинг: 0 / 0
12.02.2008, 16:24
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #35127777
AlexFred
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AlexFred
Гость
DeggasadА насчёт убрать анализ окончания страницы, то примеры были ранее. В этой задачке как раз и был смысл с учётом страниц.

Были приведены примеры, которые не учитывали результаты объединения в первом столбце =(
Ваш макрос выполняет объединение, как с учетом объединения, так и с учетом разбиения таблицы на страницы . К сожалению иногда требуется, когда учет разбиения на страницы не производится.
...
Рейтинг: 0 / 0
12.02.2008, 16:54
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #35131366
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Вот на скорую руку, а то так совсем про эту тему забуду

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
Dim StartRow As Long
Dim ColumnToMerge As Long
Dim flagCol As Boolean
Dim flagPag As Boolean


Sub test()
' объединяет ячейки содинаковыми значениями на странице в указанном столбце
Dim LastRow As Long
Dim countHPageBreak As Long
Dim hPB As HPageBreak
Dim pageLastRow() As Variant
Dim i As Long, ihPB As Long
    
    StartRow =  2  ' с какой строки начинать
    ColumnToMerge =  2  ' в какой колонке объединять
    flagCol = True   ' учитывать ли значения слева False - нет, True - да
    flagPag = False  ' учитывать ли разбиение страниц False - нет, True - да
    
 LastRow = Cells(Rows.Count, ColumnToMerge).End(xlUp).Row

    
Application.DisplayAlerts = False
If flagPag Then

    countHPageBreak = ActiveSheet.HPageBreaks.Count
    
    ReDim pageLastRow(countHPageBreak) As Variant
    
  ActiveWindow.View = xlPageBreakPreview
    i =  0 
    For Each hPB In ActiveSheet.HPageBreaks
     pageLastRow(i) = hPB.Location.Row -  1 
     i = i +  1 
    Next hPB
 ActiveWindow.View = xlNormalView
    pageLastRow(countHPageBreak) = LastRow
        
     For ihPB =  0  To countHPageBreak
       myMerg pageLastRow(ihPB)
       StartRow = pageLastRow(ihPB) +  1 
     Next ihPB
     
Else
   
      myMerg LastRow
    
End If
Application.DisplayAlerts = True

End Sub


Sub myMerg(ByVal lastToMerg As Long)
Dim RowIndex As Long
        
        For RowIndex = StartRow +  1  To lastToMerg
            
            With Cells(RowIndex, ColumnToMerge)
                
                If .Value = .Offset(- 1 ,  0 ).MergeArea.Cells( 1 ).Value Then
                  If flagCol Then
                     If .Offset( 0 , - 1 ).MergeArea( 1 ).Value = .Offset(- 1 , - 1 ).MergeArea( 1 ).Value Then  '.Offset(0, -1).MergeArea.Address <> .Offset(-1, -1).MergeArea.Address Then
                         Range(Cells(RowIndex, ColumnToMerge), .Offset(- 1 ,  0 )).Merge
                     End If
                   Else
                  Range(Cells(RowIndex, ColumnToMerge), .Offset(- 1 ,  0 )).Merge
                  End If
                End If
           
            End With
            
        Next RowIndex
End Sub
...
Рейтинг: 0 / 0
13.02.2008, 23:13
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #35131755
AlexFred
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AlexFred
Гость
2 Deggasad

Спасибо вам ОГРОМНОЕ!
...
Рейтинг: 0 / 0
14.02.2008, 09:48
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #35137513
pasha_24@ukrpost.net
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
pasha_24@ukrpost.net
Гость
DimenА можно ли сделать так, что бы объединялися ячейки любого выделенного диапазона построчто, без потери данных (примерно как в Worde), только что бы в одну строчку, с пробелом между данными из ячеек?
Заранее благодарен.


Подскажите, пожалуйста, как сделать то, что описано выше^^^, но БЕЗ ПРОБЕЛА между данными. Очень нужно.
...
Рейтинг: 0 / 0
17.02.2008, 14:43
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #35137588
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
Sub Test()
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
...
Рейтинг: 0 / 0
17.02.2008, 15:43
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #35137637
pasha_24@ukrpost.net
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
pasha_24@ukrpost.net
Гость
Deggasad
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
Sub Test()
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


Пробел пропал, но вместе с ним пропадает последний символ самого правого столбца в каждой строке
Было: | 123 | 456 | 789 |
стало: | 12345678 |
...
Рейтинг: 0 / 0
17.02.2008, 16:31
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #35137652
pasha_24@ukrpost.net
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
pasha_24@ukrpost.net
Гость
Все, разобрался, там "-1" стояло. Спасибо большое за помощь!
...
Рейтинг: 0 / 0
17.02.2008, 16:50
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #35137664
pasha_24@ukrpost.net
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
pasha_24@ukrpost.net
Гость
Еще один вопрос может подскажете. Как поставить точку в конце каждой ячейки. Допустим в ячейке "555", а нужно чтоб было "555." Все ячейки в одном столбце.
...
Рейтинг: 0 / 0
17.02.2008, 17:08
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #35137825
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
pasha_24@ukrpost.netЕще один вопрос может подскажете. Как поставить точку в конце каждой ячейки. Допустим в ячейке "555", а нужно чтоб было "555." Все ячейки в одном столбце.

Допустим наш столбец это столбец A:A, пишем в B1 формулу =A1&"." растягуем вниз, затем копируем как значения в столбец A:A если нужно. ТОлько если разделитель дробной части - точка, то предварительно наверное придётся присвоить текстовый формат.

Макросом

Код: plaintext
1.
2.
3.
Sub Макрос2()
    [A1:A4].NumberFormat = "@"
    [A1:A4] = [A1:A4 & "."]
End Sub
...
Рейтинг: 0 / 0
17.02.2008, 20:28
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #35205759
AlexFred
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AlexFred
Гость
DeggasadВот на скорую руку, а то так совсем про эту тему забуду


Доброе время суток

Программа работает великолепно. Однако появилась ситуация, когда при объединение ячеек (с учётом страниц) образовалась ячейка, высота которой оказалась меньше высоты текста, который должен в ней находится... Не могли бы вы помочь решить эту проблему... Что бы при объединение ячеек (не зависимо от условия объединения :с учётом страниц или без ) происходил бы анализ высоты находящегося в ней текста и высота ячейки подстраивалась бы под высоту текста.(чтобы высота ячейки не оказалась меньше высоты текста) Если в ручную делать всё расползается =(
...
Рейтинг: 0 / 0
21.03.2008, 12:57
| Ответить | Цитировать | Написать  
Макрос для объединения ячеек
    #35206071
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
я не могу, я вообще не очень люблю объядинять ячейки. может воспользоваться сводной таблицей. Предварительно сделав столбец с уникальным ключём для каждой записи чтобы в сводной все строки отображались. Только тогда не будут страницы учитываться
...
Рейтинг: 0 / 0
21.03.2008, 14:29
| Ответить | Цитировать | Написать  
25 сообщений из 56, страница 2 из 3
  2  все
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Макрос для объединения ячеек
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]