| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Помогите написать два простых макроса для Excel, PLS

Помогите написать два простых макроса для Excel, PLS

Ответ
Поиск в этой теме
Непрочитано 09.06.2007, 15:30 #1
Помогите написать два простых макроса для Excel, PLS
kp+
 
идущий по граблям
 
Регистрация: 26.05.2005
Сообщений: 5,091

Помогите написать два простых макроса для Excel, PLS.
Первый:
добавление пустой строки после каждой непустой строки в листе

Второй, обратный первому:
удаление пустых строк между непустыми

Заранее благодарен.
Просмотров: 7434
 
Непрочитано 09.06.2007, 15:37
#2
Кочетков Андрей

Java/Kotlin backend
 
Регистрация: 03.02.2006
Сообщений: 5,736


Удаление пустых строк:

Выделяем столбец.
Жмем F5.
Жмем "Выделить..."
Жмем "Пустые ячейки" -> OK
Правой кнопкой на выделенных ячейках -> Удалить -> Со сдвигом вверх.
Кочетков Андрей вне форума  
 
Автор темы   Непрочитано 09.06.2007, 17:15
#3
kp+

идущий по граблям
 
Регистрация: 26.05.2005
Сообщений: 5,091


Цитата:
Сообщение от Кочетков Андрей
Удаление пустых строк:

Выделяем столбец.
Жмем F5.
Жмем "Выделить..."
Жмем "Пустые ячейки" -> OK
Правой кнопкой на выделенных ячейках -> Удалить -> Со сдвигом вверх.
Спасибо. Все так просто
Но с первым макросом наверно, сложнее

Добавлено

Поспешил радоваться.
Оказывается, таблицах, с которыми приходится работать, нет столбцов, не содержащих пустых ячеек в непустых строках.
Т. е. если выбрать пустые ячейки, ориентируясь по одному столбцу, можно грохнуть строки, которые непустые, но с пустыми ячейками именно в этом столбце.

Так что нужны оба макроса. Помогите, PLS
kp+ вне форума  
 
Непрочитано 09.06.2007, 18:31
#4
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


Как вариант:

Код:
[Выделить все]
Sub DelEmptyRows()
'// удаляет пустые строки
     Dim i As Long, cnt As Long
     With ActiveSheet.UsedRange

          For i = .Rows.Count To 1 Step -1
               Dim check As Long
               check = 0
               For cnt = .Columns.Count To 1 Step -1
                    Dim cel As Range
                    Set cel = .Cells(i, cnt)
                    If IsEmpty(cel.Value) = True Then
                         check = check + 1
                    End If
               Next
               If check = .Columns.Count Then
                    .Rows(i).Delete
               End If
          Next
     End With

End Sub
~'J'~
fixo вне форума  
 
Автор темы   Непрочитано 09.06.2007, 18:35
#5
kp+

идущий по граблям
 
Регистрация: 26.05.2005
Сообщений: 5,091


Цитата:
Сообщение от Fatty
Как вариант:

Код:
[Выделить все]
Sub DelEmptyRows()
'// удаляет пустые строки
     Dim i As Long, cnt As Long
     With ActiveSheet.UsedRange

          For i = .Rows.Count To 1 Step -1
               Dim check As Long
               check = 0
               For cnt = .Columns.Count To 1 Step -1
                    Dim cel As Range
                    Set cel = .Cells(i, cnt)
                    If IsEmpty(cel.Value) = True Then
                         check = check + 1
                    End If
               Next
               If check = .Columns.Count Then
                    .Rows(i).Delete
               End If
          Next
     End With

End Sub
~'J'~
Fatty, RULEZZ!
Спасибо!!!!
kp+ вне форума  
 
Непрочитано 09.06.2007, 18:48
#6
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


Упссс, забыл второй макрос:

Код:
[Выделить все]
Sub AddAfterEmptyRows()
'// добавляет строку после пустой
     Dim i As Long, cnt As Long
     With ActiveSheet.UsedRange

          For i = .Rows.Count To 1 Step -1
               Dim check As Long
               check = 0
               For cnt = .Columns.Count To 1 Step -1
                    Dim cel As Range
                    Set cel = .Cells(i, cnt)
                    If IsEmpty(cel.Value) = True Then
                         check = check + 1
                    End If
               Next
               If check = .Columns.Count Then
                    .Rows(i + 1).Insert
               End If
          Next
     End With

End Sub
~'J'~
fixo вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Помогите написать два простых макроса для Excel, PLS

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск