Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Не получается закрыть цикл - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Не получается закрыть цикл (Макросы/Sub)
Не получается закрыть цикл
dmm Дата: Четверг, 02.04.2015, 13:22 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Всем добрый день.
Я новичок. Начал изучть VBA, т.к Экселя иногда не хватат.
Знаю, что в уже есть готовые решения на данную тему. Но хочется сделать самому.
Суть в том, что в некоторой таблице нужно удалить столбцы с пустым заголовком.
Не получается закрыть цикл.

[vba]
Код
Sub Óäàë()

Dim rngAll As Range, rngRow As Range, rngCol As Range
Dim rngCell As Range, rng1 As Range, NewRngRow As Range
Dim lngX As Long

Do
Set rngAll = ActiveSheet.UsedRange
Set rngRow = rngAll.Rows(1)

rngRow.Cells.Find("").Activate
Set rngCell = ActiveCell
Set rng1 = rngRow.Cells(, 1)

Set NewRngRow = Range(rng1.Address, rngCell.Address)
lngX = NewRngRow.Cells.Count

Set rngCol = rngAll.Columns(lngX)
rngCol.Delete

Loop Until

End Sub
[/vba]
[moder]Оформите код тегами (кнопка #)[/moder]
К сообщению приложен файл: 0783025.xlsx (15.7 Kb)


Сообщение отредактировал dmm - Четверг, 02.04.2015, 14:43
 
Ответить
СообщениеВсем добрый день.
Я новичок. Начал изучть VBA, т.к Экселя иногда не хватат.
Знаю, что в уже есть готовые решения на данную тему. Но хочется сделать самому.
Суть в том, что в некоторой таблице нужно удалить столбцы с пустым заголовком.
Не получается закрыть цикл.

[vba]
Код
Sub Óäàë()

Dim rngAll As Range, rngRow As Range, rngCol As Range
Dim rngCell As Range, rng1 As Range, NewRngRow As Range
Dim lngX As Long

Do
Set rngAll = ActiveSheet.UsedRange
Set rngRow = rngAll.Rows(1)

rngRow.Cells.Find("").Activate
Set rngCell = ActiveCell
Set rng1 = rngRow.Cells(, 1)

Set NewRngRow = Range(rng1.Address, rngCell.Address)
lngX = NewRngRow.Cells.Count

Set rngCol = rngAll.Columns(lngX)
rngCol.Delete

Loop Until

End Sub
[/vba]
[moder]Оформите код тегами (кнопка #)[/moder]

Автор - dmm
Дата добавления - 02.04.2015 в 13:22
nilem Дата: Четверг, 02.04.2015, 14:22 | Сообщение № 2
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
dmm, привет
если для учебных целей, то добавьте еще одну строку (со звездочками)
[vba]
Код
Sub Oaae()
Dim rngAll As Range, rngRow As Range, rngCol As Range
Dim rngCell As Range, rng1 As Range, NewRngRow As Range
Dim lngX As Long

Do
       Set rngAll = ActiveSheet.UsedRange
       Set rngRow = rngAll.Rows(1)

       Set rngCell = rngRow.Cells.Find("")
       If rngCell Is Nothing Then Exit Do '****
         
       Set rng1 = rngRow.Cells(, 1)

       Set NewRngRow = Range(rng1.Address, rngCell.Address)
       lngX = NewRngRow.Cells.Count

       Set rngCol = rngAll.Columns(lngX)
       rngCol.Delete
Loop
End Sub
[/vba]
а чтобы форум у нас выглядел красиво, зайдите в режим редактирования вашего сообщения, выделите строки с кодом и нажмите кнопочку # (в верхней строке)
[offtop]
С ветеранским приветом :)[/offtop]


Яндекс.Деньги 4100159601573

Сообщение отредактировал nilem - Четверг, 02.04.2015, 14:28
 
Ответить
Сообщениеdmm, привет
если для учебных целей, то добавьте еще одну строку (со звездочками)
[vba]
Код
Sub Oaae()
Dim rngAll As Range, rngRow As Range, rngCol As Range
Dim rngCell As Range, rng1 As Range, NewRngRow As Range
Dim lngX As Long

Do
       Set rngAll = ActiveSheet.UsedRange
       Set rngRow = rngAll.Rows(1)

       Set rngCell = rngRow.Cells.Find("")
       If rngCell Is Nothing Then Exit Do '****
         
       Set rng1 = rngRow.Cells(, 1)

       Set NewRngRow = Range(rng1.Address, rngCell.Address)
       lngX = NewRngRow.Cells.Count

       Set rngCol = rngAll.Columns(lngX)
       rngCol.Delete
Loop
End Sub
[/vba]
а чтобы форум у нас выглядел красиво, зайдите в режим редактирования вашего сообщения, выделите строки с кодом и нажмите кнопочку # (в верхней строке)
[offtop]
С ветеранским приветом :)[/offtop]

Автор - nilem
Дата добавления - 02.04.2015 в 14:22
dmm Дата: Четверг, 02.04.2015, 14:49 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
спасибо.
 
Ответить
Сообщениеспасибо.

Автор - dmm
Дата добавления - 02.04.2015 в 14:49
Kuzmich Дата: Четверг, 02.04.2015, 16:41 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 712
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
В модуль листа
[vba]
Код

Sub DelCol()
Dim i As Integer
Dim iLCol As Integer
     iLCol = Cells(2, Columns.Count).End(xlToLeft).Column
     For i = iLCol To 1 Step -1
         If IsEmpty(Cells(2, i)) Then
            Cells(2, i).EntireColumn.Delete
         End If
     Next
End Sub

[/vba]
 
Ответить
СообщениеВ модуль листа
[vba]
Код

Sub DelCol()
Dim i As Integer
Dim iLCol As Integer
     iLCol = Cells(2, Columns.Count).End(xlToLeft).Column
     For i = iLCol To 1 Step -1
         If IsEmpty(Cells(2, i)) Then
            Cells(2, i).EntireColumn.Delete
         End If
     Next
End Sub

[/vba]

Автор - Kuzmich
Дата добавления - 02.04.2015 в 16:41
dmm Дата: Понедельник, 06.04.2015, 14:58 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Написал сам код. Но почему-то его нужно запускать 2 раза, чтобы он удалил все столбцы (с пустыми заголовками) в диапазоне .
Подскажите в чем тут дело.
К сообщению приложен файл: _11111.xlsm (40.1 Kb)
 
Ответить
СообщениеНаписал сам код. Но почему-то его нужно запускать 2 раза, чтобы он удалил все столбцы (с пустыми заголовками) в диапазоне .
Подскажите в чем тут дело.

Автор - dmm
Дата добавления - 06.04.2015 в 14:58
KSV Дата: Понедельник, 06.04.2015, 15:05 | Сообщение № 6
Группа: Друзья
Ранг: Ветеран
Сообщений: 770
Репутация: 255 ±
Замечаний: 0% ±

Excel 2013
потому, что при удалении в цикле со счетчиком, нужно перемещаться от последнего к первому, вот так:
[vba]
Код
            For i = rngRow.cells.Count To 1 Step -1
                  If cells(1, i) = "" Then Columns(i).Delete
              Next i
[/vba]


KSV.VBA@gmail.com
Яндекс.Деньги: 410011921213333


Сообщение отредактировал KSV - Понедельник, 06.04.2015, 15:06
 
Ответить
Сообщениепотому, что при удалении в цикле со счетчиком, нужно перемещаться от последнего к первому, вот так:
[vba]
Код
            For i = rngRow.cells.Count To 1 Step -1
                  If cells(1, i) = "" Then Columns(i).Delete
              Next i
[/vba]

Автор - KSV
Дата добавления - 06.04.2015 в 15:05
dmm Дата: Понедельник, 06.04.2015, 15:09 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Ясно
 
Ответить
СообщениеЯсно

Автор - dmm
Дата добавления - 06.04.2015 в 15:09
nilem Дата: Понедельник, 06.04.2015, 15:11 | Сообщение № 8
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
или за раз
[vba]
Код
Sub ttt()
On Error Resume Next
Intersect(ActiveSheet.UsedRange, Rows(1)).SpecialCells(4).EntireColumn.Delete
End Sub
[/vba]


Яндекс.Деньги 4100159601573
 
Ответить
Сообщениеили за раз
[vba]
Код
Sub ttt()
On Error Resume Next
Intersect(ActiveSheet.UsedRange, Rows(1)).SpecialCells(4).EntireColumn.Delete
End Sub
[/vba]

Автор - nilem
Дата добавления - 06.04.2015 в 15:11
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Не получается закрыть цикл (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!