Страницы: 1
RSS
Удаление пустых столбцов
 
Здравствуйте!
Понимаю что тема избита, на старом форуме ответов масса, однако при попытке скачать файл с примером меня перебрасывает на новую версию сайта и на этом все.
Задачка у меня простая, удалить пустые столбцы на листе с определенным именем, оставить только столбцы с текстом или значениями.
 
62.76.186.34 пробовали?.. Ссылки правим - вместо www.planetaexcel.ru... Старый форум - http://62.76.186.34/forum.php?forum_id=119...
Изменено: Z - 28.12.2012 23:34:02
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
Я так и делал, сообщение читать можно, а скачать пример не получается!

Тут http://www.planetaexcel.ru/tip.php?aid=31 наверно есть ответ  на мой вопрос но ссылка перебрасывает на блог!
Может у кого нибудь есть примерчик, или макросик!!!
 
??? - http://62.76.186.34/tip.php?aid=31 однако ваше?..
  1.  Sub DeleteEmptyRows()  
  2.     LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count  
  3.     Application.ScreenUpdating = False  
  4.     For r = LastRow To 1 Step -1  
  5.         If Application.CountA(Rows®) = 0 Then Rows®.Delete  
  6.     Next r  
  7. End Sub
Циферки убрать!
Изменено: Z - 26.12.2012 12:34:03
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
Попробовал заменить Row  на Column чтобы столбцы удалялись но в итоге ничего не получилось (взгрустнулось вновь из-за незнания программирования). Что и как заменить чтобы удалялись столбцы???, подскажите пожалуйста!
 
Код
Sub DeleteEmptyRows() 
 Dim i
 LastRow = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count 
 Application.ScreenUpdating = False 
  For i = LastRow To 1 Step -1 
     If Application.CountA(Columns(i)) = 0 Then Columns(i).Delete 
  Next i 
 End Sub
 
Спасибо, большое!!! То что нужно!!!
Снова взгрустнулось от незнания бэйсика.
 
Михаил, как-то не очень симпатично переменную столбца обозвать LastRow  :)
 
Юрий, был вопрос:
Цитата
Timur пишет:
Что и как заменить чтобы удалялись столбцы???
что я и делал.  :D
А симпатично или нет - эт кому как нравится :)

Хотя, в принципе, вы правы.
 
Код
Код
Sub DeleteEmptyRows() 
 Dim i
 LastRow = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count 
 Application.ScreenUpdating = False 
  For i = LastRow To 1 Step -1 
     If Application.CountA(Columns(i)) = 0 Then Columns(i).Delete 
  Next i 
 End Sub


А как его дополнить, что бы он анализировал данные со второй строки? То есть я так понимаю что он удаляет именно те столбцы где нет вообще никаких данных а допустим если эта таблица где первая строка шапка, соответственно у столбца есть название и он его не удаляет, а данных по нему нет.
 
Наверно так:)
Код
Sub DeleteEmptyCol() 
Dim i&, LastRow&, LastCol&
   with ActiveSheet.UsedRange
      LastRow = .Row - 1 + .Rows.Count 
      LastCol = .Column - 1 + .Columns.Count 
   end with
   Application.ScreenUpdating = False 
   For i = LastCol To 1 Step -1 
      If Application.CountA(range(cells(2,i),cells(LastRow,i))) = 0 Then Columns(i).Delete 
        Next i 
 End Sub
 
Igor67, спасибо большое)
 
У меня не работает, не понимаю что делаю не так. Помогите пожалуйста.
Не удаляет столбцы и все тут.
Пробовал 2 макроса из этой ветки и 1 макрос нашел в интернете.
Код
Sub Udalenie_Pustyh_Stolbtsov()
Dim c As Long, FirstColumn As Long, LastColumn As Long
FirstColumn = ActiveSheet.UsedRange.Column
LastColumn = ActiveSheet.UsedRange.Columns.Count - 1 + ActiveSheet.UsedRange.Column
    For c = LastColumn To FirstColumn Step -1
        If Application.CountA(Columns(c)) = 0 Then
            Columns(c).Delete
        End If
    Next c
End Sub
Код
Sub DeleteEmptyRows() 
 Dim i
 LastRow = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count 
 Application.ScreenUpdating = False
  For i = LastRow To 1 Step -1 
     If Application.CountA(Columns(i)) = 0 Then Columns(i).Delete 
  Next i 
 End Sub
Код
Sub DeleteEmptyCol() 
Dim i&, LastRow&, LastCol&
   with ActiveSheet.UsedRange
      LastRow = .Row - 1 + .Rows.Count 
      LastCol = .Column - 1 + .Columns.Count 
   end with
   Application.ScreenUpdating = False
   For i = LastCol To 1 Step -1 
      If Application.CountA(range(cells(2,i),cells(LastRow,i))) = 0 Then Columns(i).Delete 
        Next i 
 End Sub
 
mig-zzz, последний код работает
 
С моим файлом или вообще? Вообще да, но с моим файлом не получилось включить.
 
mig-zzz, с вашим файлом работает макрос
у вас в файле стоят фильтры. Возможно, у вас они включены.
 
Цитата
Hellmaster написал:
mig-zzz , с вашим файлом работает макросу вас в файле стоят фильтры. Возможно, у вас они включены.
Наверное вы имеете ввиду группировки столбцов? Если да, то они открыты. Речь идет именно об этом файле, который я приложил.
3й скрипт работает начиная со 2й строки, а мне надо чтобы он работал с 1й. А если я 1ю строку с заголовками вставяляю во 2ю он уже не работает, как и все остальные.
 
ап
 
Попробуйте в третьем макросе из #13 заменить строку проверки и удаления на такую:
Код
If Application.CountBlank(Range(Cells(1, i), Cells(LastRow, i))) = LastRow Then Columns(i).Delete
Страницы: 1
Наверх