Всем здравствуйте! Нужно объединять ячейки с сохранением текста. Строк около 5000. Нашел пример как объединять, но не могу понять как прописать цикл.... подскажите пожалуйста. Нужно объединять ячейки в строке в диапазоне A1:E1, и так до A5000:E5000. Причем нужно чтобы при установленном фильтре объединялись только видимые ячейки. Невидимые не нужно объединять. Макрос нашел в примерах, но не могу с циклом разобраться... Думаю там всё просто должно быть, но как именно - понять не могу, туплю уже часа 3 над этим) Пример прилагаю. Помогите плз.
Sub MergeToOneCell()
Dim rCell As Range
Range(Cells(1, 1), Cells([A1000000].End(xlUp).Row, 1)).SpecialCells(xlCellTypeVisible).Select
Application.DisplayAlerts = False 'отключаем стандартное предупреждение о потере текста
For Each rCell In Selection.Cells
sMergeStr = txt(rCell)
rCell.Resize(1, 5).Merge Across:=False 'объединяем ячейки
rCell = sMergeStr 'добавляем к объед.ячейке суммарный текст
Next rCell
Application.DisplayAlerts = True
End Sub
Function txt(r As Range)
arr = r.Resize(1, 5)
txt = arr(1, 1)
For i = 2 To UBound(arr, 2)
txt = txt & " " & arr(1, i)
Next
End Function
Sub MergeToOneCell()
Const sDELIM As String = " " 'символ-разделитель
Dim rCell As Range
Dim sMergeStr As String
Application.DisplayAlerts = False
For Each rw In ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Rows
rww = rw.Row
If rww > 1 Then
sMergeStr = ""
For i = 1 To 5
sMergeStr = sMergeStr & sDELIM & Cells(rww, i).Text 'собираем текст из ячеек
Next
Cells(rww, 1).Resize(, 5).Merge
Cells(rww, 1) = LTrim(sMergeStr)
End If
Next
Application.DisplayAlerts = True
End Sub
skais675, Применил этот вариант, работает. А как сделать чтоб по строкам объединялись смежные ячейки столбцов Fи G? При этом чтоб в них закидывался текст из диапазонов F:M ? Что нужно поменять в коде?
Sub MergeToOneCell222()
Const sDELIM As String = " " 'символ-разделитель
Dim rCell As Range
Dim sMergeStr As String
Application.DisplayAlerts = False
For Each rw In ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Rows
rww = rw.Row
If rww > 1 Then
sMergeStr = ""
For i = 1 To 5
sMergeStr = sMergeStr & sDELIM & Cells(rww, i).Text 'собираем текст из ячеек
Next
Cells(rww, 1).Resize(, 5).Merge
Cells(rww, 1) = LTrim(sMergeStr)
s2 = ""
For i = 6 To 13
s2 = s2 & sDELIM & Cells(rww, i).Text 'собираем текст из ячеек
Next
Cells(rww, 6).Resize(, 2).Merge
Cells(rww, 6) = s2
End If
Next
Application.DisplayAlerts = True
End Sub
Это означает, что для первого аргумента используется значение по умолчанию. В данном случае это означает, что изменение размера по строкам не происходит.