VBA объединение и скрытие SOS!!!

[DJTreeno]

Доброго всем времени суток!!!

Извиняюсь, что начинаю новую тему, но у меня неправильно работают макросы из этой темы http://programmersforum.ru/showthrea...571#post825571

Дело в том, что макрос который предложил EugeneS с кодом:

Sub test()
With Application: .ScreenUpdating = False: .DisplayAlerts = False
For Each ar In Range([a1], Cells(Rows.Count, "a").End(xlUp)).SpecialCells(xlCell TypeConstants, xlNumbers).Areas
ar.Offset(-1).Resize(ar.Rows.Count + 1).Merge
Next: .ScreenUpdating = True: .DisplayAlerts = True: End With: End Sub

И макрос, который подправил kuklp с кодом:
Sub Объединение()
Dim RowIndex As Long
Dim StartRow As Long
Dim LastRow As Long
Dim ColumnToMerge As Long

StartRow = 1 ' с какой строки начинать
ColumnToMerge = 1 ' в какой колонке объединять

LastRow = Cells(Rows.Count, ColumnToMerge).End(xlUp).Row

Application.DisplayAlerts = False

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

Application.DisplayAlerts = True

End Sub

Имеет один и тот же существенный недостаток - при их первом нажатии они все делает правильно, но при повторном первый выдает ошибку, а второй некорректно себя ведет.

Выход я нашел, но на мой взгляд он какой-то идиотский - вначале кода обоих макросов вставить код, который разбивает все ячейки.

Если не трудно посоветуйте как быть.

И еще помогите пожалуйста с макросом, который в столбце А при попадании на значение 0 скрывает строку и идет дальше искать нули. У меня получилось сделать только, когда нули в конце:

Sub Группировка()
For i = 1 To 1000
If Range("X" & Trim(Str(i))).Value = "0" Then
Exit For
End If
Next
Range("Z1") = i

Range(Cells(i, 24), Cells(1000, 24)).Select
Selection.RowHeight = 0
End Sub

Заранее благодарен!!!

[EugeneS]

мой код можно подправить следующим образом, ошибки при повторном запуске не будет:

Sub test()
On Error Resume Next: Set myrange = Range([a1], Cells(Rows.Count, "a").End(xlUp)).SpecialCells(xlCellTypeConstants, xlNumbers)
If Err.Number = 0 Then
    With Application: .ScreenUpdating = False: .DisplayAlerts = False
    For Each ar In myrange.Areas: ar.Offset(-1).Resize(ar.Rows.Count + 1).Merge: Next
    .ScreenUpdating = True: .DisplayAlerts = True: End With
Else
    Exit Sub
End If: End Sub

[nilem]

.Areas.Item(1) тоже помогает:

Sub testMerge()
Dim r As Range
With Application
    .ScreenUpdating = 0: .DisplayAlerts = 0
    For Each r In Range([a1], Cells(Rows.Count, 1).End(xlUp)).Areas.Item(1)
        If r.Value = 0 Then Range(r, r.Offset(-1)).Merge
    Next
    .ScreenUpdating = 1: .DisplayAlerts = 1
End With
End Sub

И для скрытых строк:

Sub testHide() 'объединенных ячеек нет!
Dim r As Range, rh As Range
Application.ScreenUpdating = 0
For Each r In Range([a1], Cells(Rows.Count, 1).End(xlUp)).Cells
    If r.Value = 0 Then
        If rh Is Nothing Then Set rh = r Else Set rh = Union(r, rh)
    End If
Next
If Not rh Is Nothing Then rh.EntireRow.Hidden = 1
Application.ScreenUpdating = 1
End Sub

[DJTreeno]

Уважаемый EugeneS теперь все хорошо, но как мне сделать, чтоб этот макрос работал с ячейками в которых стоит знак равно и ссылка на другую ячейку? Он работает только с ячейками, которые вводит пользователь, а с расчетными нет ((

[DJTreeno]

nilem, спасибо за помощь Ваш макрос Sub testMerge() работает отлично, но вот второй Sub testHide() не совсем правильно, нужно чтоб сканировало по столбцу и как только увидит 0 скрыло и продолжило сканировать. Вы наверно просто неправильно меня поняли я думаю, что строка:

If rh Is Nothing Then Set rh = r Else Set rh = Union(r, rh)

тут не подходит

Фух одной проблемой меньше, чувствую что как-то просто должно быть, но знаний не хватает, если не трудно посмотрите еще.

[DJTreeno]

nilem, я вот понимаю эту задачу, что цикл должен идти построчно и не искать интервалы с нулями, а просто видит ноль - скрывает, не видит - идет дальше искать, а выход из цикла по достижению значения в 2000 строк.
Все равно машина не тянет свыше 3000 строк с формулами.

[nilem]

Сообщение от DJTreeno

нужно чтоб сканировало по столбцу и как только увидит 0 скрыло и продолжило сканировать

Т.е. нужно скрыть только первую попавшуюся строку с нулем в первом столбце?
Мож примерчик?

видит ноль - скрывает, не видит - идет дальше искать

Вроде так и делает?

[DJTreeno]

Ну пример такой:
1
1
1
0
1
1
1
0
0
0
1
1
1
0
0
1
1
0
0

получатся, что нужно скрыть строки с нулями, а единицы не трогать

[DJTreeno]

nilem, хотя вроде работает, он просто скрывал почему-то пустые ячейки еще, думаю я это обойду, если не получится, буду просить помочь еще раз. Спасибо за участие!!!

[nilem]

Правда, пустые тоже скрывает. Тогда поставьте r.Text вместо r.Value в этой строке:

If r.Text = 0 Then

т.е. скрываем нули, как они есть в ячейке.