Добрый день, есть отлично работающий макрос но только ни как не могу добиться чтобы строки удалялись а не скрывались. Если кто подскажет, буду благодарен.
[vba]
Код
Sub №1() ' ' №1 Макрос '
' Columns("F:H").Hidden = True Columns("J:S").Hidden = True Rows("1:7").Hidden = True Dim cell As Range Application.ScreenUpdating = False 'отключаем обновление экрана для ускорения For Each cell In ActiveSheet.UsedRange.Rows(1).Cells 'проходим по всем ячейкам первой строки If cell.Value = "*" Then cell.EntireColumn.Hidden = True 'если в ячейке x - скрываем столбец Next For Each cell In ActiveSheet.UsedRange.Columns(1).Cells 'проходим по всем ячейкам первого столбца If cell.Value = "*" Then cell.EntireRow.Hidden = True 'если в ячейке x - скрываем строку Next Application.ScreenUpdating = True End Sub
[/vba]
Добрый день, есть отлично работающий макрос но только ни как не могу добиться чтобы строки удалялись а не скрывались. Если кто подскажет, буду благодарен.
[vba]
Код
Sub №1() ' ' №1 Макрос '
' Columns("F:H").Hidden = True Columns("J:S").Hidden = True Rows("1:7").Hidden = True Dim cell As Range Application.ScreenUpdating = False 'отключаем обновление экрана для ускорения For Each cell In ActiveSheet.UsedRange.Rows(1).Cells 'проходим по всем ячейкам первой строки If cell.Value = "*" Then cell.EntireColumn.Hidden = True 'если в ячейке x - скрываем столбец Next For Each cell In ActiveSheet.UsedRange.Columns(1).Cells 'проходим по всем ячейкам первого столбца If cell.Value = "*" Then cell.EntireRow.Hidden = True 'если в ячейке x - скрываем строку Next Application.ScreenUpdating = True End Sub
Sub deleteEmptyRows() Dim x, i&, delRa As Range x = Range("A1:A" & [a65535].End(xlUp).Row).Value For i = 1 To UBound(x) If x(i, 1) = "*" Then If delRa Is Nothing Then Set delRa = Cells(i, 1) Else Set delRa = Union(Cells(i, 1), delRa) End If End If Next If Not delRa Is Nothing Then delRa.EntireRow.Delete End Sub
[/vba]
большое спасибо пользователю SkyPro если есть замечания то скажите ваши комментарии.
Друзья нашел тут же! Работает вроде как надо
[vba]
Код
Sub deleteEmptyRows() Dim x, i&, delRa As Range x = Range("A1:A" & [a65535].End(xlUp).Row).Value For i = 1 To UBound(x) If x(i, 1) = "*" Then If delRa Is Nothing Then Set delRa = Cells(i, 1) Else Set delRa = Union(Cells(i, 1), delRa) End If End If Next If Not delRa Is Nothing Then delRa.EntireRow.Delete End Sub
[/vba]
большое спасибо пользователю SkyPro если есть замечания то скажите ваши комментарии.вадим0101
Сообщение отредактировал Pelena - Пятница, 15.07.2016, 14:39