powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Удаление столбцов с помощью макроса
25 сообщений из 33, страница 1 из 2
Удаление столбцов с помощью макроса
    #34751102
dimasusis
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Всем привет!У меня есть большая ценовая таблица,где по строкам указан перечень товаров,а по столбцам идут месяцы.У меня вопрос,как сделать чтобы макрос удалял столбцы с определённым названия месяца.Например,хочу чтобы остались месяцы январь,июнь,а остальные были удалены.
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34751184
Фотография big-duke
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
Public Sub DelMonthColumn()
    Dim R As Range, Target As String
    For Each R In Range("A1:L1")
        Select Case R.Value
          Case "январь","июнь"
          Case Else
          Target = Target & R.Address & ","
          
        End Select
    Next
    Target = Left(Target, Len(Target) -  1 )
    Range(Target).EntireColumn.Delete

End Sub
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34751217
dimasusis
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Спасибо за быстрый ответ!Но роблема в том,что месяцы указаны в 3 строки ,а в первой и второй указаны производители.И ещё названя месяца объединено в 3 ячейки
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34751236
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
dimasusisСпасибо за быстрый ответ!Но роблема в том,что месяцы указаны в 3 строки ,а в первой и второй указаны производители.И ещё названя месяца объединено в 3 ячейки
Так выложи файл!

З.ы.
2модераторам:
Может где то на видном месте повесить объяву, что мол по возможности выкладывать пример в файле.
Модератор:
Не любит у нас народ правила читать. Менталитет наверное не тот.
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34751267
dimasusis
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34751358
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
НАпример так
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
Sub DelMonthColumn()
    Dim R As Range, Target As Range
    
    For Each R In Range("B2:R2")
      If R.Value <> "" Then
        If R.Value <> "Январь" And R.Value <> "Июль" Then
          If Target Is Nothing Then
               Set Target = R.MergeArea
           Else
               Set Target = Union(Target, R.MergeArea)
          End If
        End If
      End If
    Next
    
    Target.EntireColumn.Delete

End Sub
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34751436
dimasusis
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Спасибо попробую
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34751452
dimasusis
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
а если в книге несколько столбцов.Ты извини,что я такой настырный.Просто недавно занялся изучением макросов
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34751467
dimasusis
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
ой!Ошибся!!Несколько листов и во всех надо удалить ненужные столбцы
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34751482
Фотография big-duke
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
dimasusisой!Ошибся!!Несколько листов и во всех надо удалить ненужные столбцы
Тогда обойдите листы в цикле и запускайте предложенную Deggasad процедуру.
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34751504
dimasusis
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
а как это сделать?Цикл?
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34751630
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
dimasusisа как это сделать?Цикл?


Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
Sub DelMonthColumn()
Dim R As Range, Target As Range, ws as worksheet
  For Each ws in Activeworkbook.worksheets  
    For Each R In ws.Range("B2:IV2").End(xlToLeft)
      If R.Value <> "" Then
        If R.Value <> "Январь" And R.Value <> "Июль" Then
          If Target Is Nothing Then
               Set Target = R.MergeArea
           Else
               Set Target = Union(Target, R.MergeArea)
          End If
        End If
      End If
    Next R
    
    Target.EntireColumn.Delete
    Set Target = Nothing

 Next ws
End Sub

Где-то так должно быть
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34751661
dimasusis
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
спасибо
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34754400
dimasusis
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Deggasad dimasusisа как это сделать?Цикл?


Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
Sub DelMonthColumn()
Dim R As Range, Target As Range, ws as worksheet
  For Each ws in Activeworkbook.worksheets  
    For Each R In ws.Range("B2:IV2").End(xlToLeft)
      If R.Value <> "" Then
        If R.Value <> "Январь" And R.Value <> "Июль" Then
          If Target Is Nothing Then
               Set Target = R.MergeArea
           Else
               Set Target = Union(Target, R.MergeArea)
          End If
        End If
      End If
    Next R
    
    Target.EntireColumn.Delete
    Set Target = Nothing

 Next ws
End Sub

Где-то так должно быть

Я дико извиняюсь,но я что-то не могу разобраться как это работает.Ты не мог бы дать описание каждой строки,что она делает
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34754554
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Deggasad
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
Sub DelMonthColumn()
Dim R As Range, Target As Range, ws as worksheet
' запуск цикла по всем рабочим листам
  For Each ws in Activeworkbook.worksheets  
' запуск цикла по всем ячейкам второй строки, начиная со второго столбца, заканчивая последней заполненной  
  For Each R In ws.Range("B2:IV2").End(xlToLeft)
' Проверка - Если ячейка не пустая, то идём дальше 
     If R.Value <> "" Then
' Проверка - Если значение в ячейке неравно "Январь" и неравно "Июль", то идём дальше 
        If R.Value <> "Январь" And R.Value <> "Июль" Then
' Проверка - Если наш итоговый диапазон ещё пустой, то приравниваем его к объединённому диапазону, в который входит наша непустая ячейка и не равная нашим месяцам. Если наш итоговый диапазон Target уже непустой, то объединяем его с всё с той же областью объединённой ячейки.
          If Target Is Nothing Then
               Set Target = R.MergeArea
           Else
               Set Target = Union(Target, R.MergeArea)
          End If
        End If
      End If
' Следующая ячейка
    Next R

'Удаляем все строки, которым принадлежат ячейки нешего итогового диапазона    
    Target.EntireColumn.Delete
' обнуление переменной итогового диавпазона
    Set Target = Nothing
' Следующий лист
 Next ws
End Sub

Где-то так должно быть
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34757166
dimasusis
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Deggasad Deggasad
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
Sub DelMonthColumn()
Dim R As Range, Target As Range, ws as worksheet
' запуск цикла по всем рабочим листам
  For Each ws in Activeworkbook.worksheets  
' запуск цикла по всем ячейкам второй строки, начиная со второго столбца, заканчивая последней заполненной  
  For Each R In ws.Range("B2:IV2").End(xlToLeft)
' Проверка - Если ячейка не пустая, то идём дальше 
     If R.Value <> "" Then
' Проверка - Если значение в ячейке неравно "Январь" и неравно "Июль", то идём дальше 
        If R.Value <> "Январь" And R.Value <> "Июль" Then
' Проверка - Если наш итоговый диапазон ещё пустой, то приравниваем его к объединённому диапазону, в который входит наша непустая ячейка и не равная нашим месяцам. Если наш итоговый диапазон Target уже непустой, то объединяем его с всё с той же областью объединённой ячейки.
          If Target Is Nothing Then
               Set Target = R.MergeArea
           Else
               Set Target = Union(Target, R.MergeArea)
          End If
        End If
      End If
' Следующая ячейка
    Next R

'Удаляем все строки, которым принадлежат ячейки нешего итогового диапазона    
    Target.EntireColumn.Delete
' обнуление переменной итогового диавпазона
    Set Target = Nothing
' Следующий лист
 Next ws
End Sub

Где-то так должно быть

Спасибо!Разобрался!Но возникла другая проблема.Изначальна у меня название месяца цепляется ссылками из другого файла.С помощью макроса я меняю ссылки на значения и потом с помощью этого макроса удаляю все столбцы "Август".И он почемуто удаляет все столбцы на одном листе,на другом часть столбцов "Август" оставляет,а некоторые столбцы "Август" вместе с остальными удаляет.Я попробовал вручную(с клавиатуры) пробить название месяца "Август" в столбцах и макрос заработал великолепно.В чём может быть проблема.Вот макрос для замены ссылок на значения:
Sheets("Лист1").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34757399
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Замену формул на знеачения вставил, см 6 строку

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
Sub DelMonthColumn()
Dim R As Range, Target As Range, ws as worksheet
' запуск цикла по всем рабочим листам
  For Each ws in Activeworkbook.worksheets
'  Для замены формул на значения
 ws.usedrange.value = ws.usedrange.value
 ' запуск цикла по всем ячейкам второй строки, начиная со второго столбца, заканчивая последней заполненной  
  For Each R In ws.Range("B2:IV2").End(xlToLeft)
' Проверка - Если ячейка не пустая, то идём дальше 
     If R.Value <> "" Then
' Проверка - Если значение в ячейке неравно "Январь" и неравно "Июль", то идём дальше 
        If R.Value <> "Январь" And R.Value <> "Июль" Then
' Проверка - Если наш итоговый диапазон ещё пустой, то приравниваем его к объединённому диапазону, в который входит наша непустая ячейка и не равная нашим месяцам. Если наш итоговый диапазон Target уже непустой, то объединяем его с всё с той же областью объединённой ячейки.
          If Target Is Nothing Then
               Set Target = R.MergeArea
           Else
               Set Target = Union(Target, R.MergeArea)
          End If
        End If
      End If
' Следующая ячейка
    Next R

'Удаляем все строки, которым принадлежат ячейки нешего итогового диапазона    
    Target.EntireColumn.Delete
' обнуление переменной итогового диавпазона
    Set Target = Nothing
' Следующий лист
 Next ws
End Sub

А что касается того что некоторые месяцы удаляет, то может у них регистр первой быквы разный, например в макросе с большой а в файле с маленькой.
Попробуйте вместо строки
Код: plaintext
If R.Value <> "Январь" And R.Value <> "Июль" Then
, написать
Код: plaintext
If UCase(R.Value) <> "ЯНВАРЬ" And UCase(R.Value) <> "ИЮЛЬ" Then
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34757520
dimasusis
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
да нет,регистр одинаковый
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34757536
dimasusis
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Запускаю твой макрос,выдаёт ошибку в строке Target.EntireColumn.Delete
Object variable or With block variable not set (Error 91)
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34757604
dimasusis
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
dimasusisЗапускаю твой макрос,выдаёт ошибку в строке Target.EntireColumn.Delete
Object variable or With block variable not set (Error 91)

Ну тут я разобрался.У меня открыты два файла,так как в файле с ссылками прописана формула СМЕЩ.Я прописал в строке For Each ws In Workbooks("Книга1.xls"). Worksheets.И теперь он мне ошибку 9 выдаёт
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34757903
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Извиняюсь была небольшая ошибочка, я поравил + добавил кое-что
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
Sub DelMonthColumn()
Dim R As Range, Target As Range, ws as worksheet
' запуск цикла по всем рабочим листам
  For Each ws in Activeworkbook.worksheets
'  Для замены формул на значения
 ws.usedrange.value = ws.usedrange.value
 ' запуск цикла по всем ячейкам второй строки, начиная со второго столбца, заканчивая последней заполненной  
  For Each R In  ws.Range("B2", ws.Range("B2:IV2").End(xlToLeft))
' Проверка - Если ячейка не пустая, то идём дальше 
     If R.Value <> "" Then
' Проверка - Если значение в ячейке неравно "Январь" и неравно "Июль", то идём дальше (имена месяцев в верхнем регистре)
        If UCase(R.Value) <> "ЯНВАРЬ" And UCase(R.Value) <> "ИЮЛЬ" Then 
' Проверка - Если наш итоговый диапазон ещё пустой, то приравниваем его к объединённому диапазону, в который входит наша непустая ячейка и не равная нашим месяцам. Если наш итоговый диапазон Target уже непустой, то объединяем его с всё с той же областью объединённой ячейки.
          If Target Is Nothing Then
               Set Target = R.MergeArea
           Else
               Set Target = Union(Target, R.MergeArea)
          End If
        End If
      End If
' Следующая ячейка
    Next R

'Удаляем все строки, которым принадлежат ячейки нешего итогового диапазона, если он не пустой
    If not Target Is Nothing Then Target.EntireColumn.Delete
' обнуление переменной итогового диавпазона
    Set Target = Nothing
' Следующий лист
 Next ws
End Sub
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34758198
dimasusis
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
DeggasadИзвиняюсь была небольшая ошибочка, я поравил + добавил кое-что
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
Sub DelMonthColumn()
Dim R As Range, Target As Range, ws as worksheet
' запуск цикла по всем рабочим листам
  For Each ws in Activeworkbook.worksheets
'  Для замены формул на значения
 ws.usedrange.value = ws.usedrange.value
 ' запуск цикла по всем ячейкам второй строки, начиная со второго столбца, заканчивая последней заполненной  
  For Each R In  ws.Range("B2", ws.Range("B2:IV2").End(xlToLeft))
' Проверка - Если ячейка не пустая, то идём дальше 
     If R.Value <> "" Then
' Проверка - Если значение в ячейке неравно "Январь" и неравно "Июль", то идём дальше (имена месяцев в верхнем регистре)
        If UCase(R.Value) <> "ЯНВАРЬ" And UCase(R.Value) <> "ИЮЛЬ" Then 
' Проверка - Если наш итоговый диапазон ещё пустой, то приравниваем его к объединённому диапазону, в который входит наша непустая ячейка и не равная нашим месяцам. Если наш итоговый диапазон Target уже непустой, то объединяем его с всё с той же областью объединённой ячейки.
          If Target Is Nothing Then
               Set Target = R.MergeArea
           Else
               Set Target = Union(Target, R.MergeArea)
          End If
        End If
      End If
' Следующая ячейка
    Next R

'Удаляем все строки, которым принадлежат ячейки нешего итогового диапазона, если он не пустой
    If not Target Is Nothing Then Target.EntireColumn.Delete
' обнуление переменной итогового диавпазона
    Set Target = Nothing
' Следующий лист
 Next ws
End Sub


Спасибо.А вот чтобы он просматривал листы именно в одной книге,я правильно написал?
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34758607
dimasusis
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Всё равно не работает.Что я не так делаю не пойму
Выложу этот файл с таблицей,в который нужно оставить столбцы "Сентябрь" и перечень товара(А2),а остальное удалить.К нему я приклеил этот макрос.Посмотри,что я не так делаю.Плиззз!!!
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34758971
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
1) Опять пардон
Вместо
Код: plaintext
 For Each R In  ws.Range("B2", ws.Range("B2:IV2").End(xlToLeft))
вот это
Код: plaintext
  For Each R In ws.Range("B2", ws.Range("IV2").End(xlToLeft))


2) Я там написал, что имена месяцав в макросе обязательно указывать в верхнем регистре, т.е. заглавными буквами, например, СЕНТЯБРЬ
...
Рейтинг: 0 / 0
Удаление столбцов с помощью макроса
    #34759183
dimasusis
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Deggasad1) Опять пардон
Вместо
Код: plaintext
 For Each R In  ws.Range("B2", ws.Range("B2:IV2").End(xlToLeft))
вот это
Код: plaintext
  For Each R In ws.Range("B2", ws.Range("IV2").End(xlToLeft))


2) Я там написал, что имена месяцав в макросе обязательно указывать в верхнем регистре, т.е. заглавными буквами, например, СЕНТЯБРЬ

Спасибо!
...
Рейтинг: 0 / 0
25 сообщений из 33, страница 1 из 2
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Удаление столбцов с помощью макроса
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]