Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
удалить все столбцы кроме определенных (VBA)
 
#1
28.01.2014 16:42:16
всем доброго времени суток
извините, что Вас беспокоил
прошу помочь мне, не знаю с чего начать
есть таблица: больше 132 - столбцы, больше 10 000 строк
из этой таблицы мне нужны примерно только 10 столбцы, которые находятся в разных местах
можно ли написать такой макрос, чтобы он удалил все столбцы, кроме определенных, например:
Номер модели,
Код цвета,
Цена (оптовая),
Цена (розничная),
Объем оперативной памяти,
Количество заказа
и т.к.
Спасибо за понимание и потраченное драгоценное время
 
 
 
#2
28.01.2014 16:43:56
Да один раз это проще и быстрей сделать руками, чем писать макрос.
Я сам - дурнее всякого примера! ...
 
 
 
#3
28.01.2014 16:45:57
Цитата
можно ли написать такой макрос
Можно. Но, наверное, вам надо попробывать выбрать только нужное на другой лист РАСШИРЕННЫМ ФИЛЬТРОМ, а свои действия записать рекордером. И старые данные будут целы ( про запас) и новые-сокращенные не помешают...  ;)
Изменено: Z - 28.01.2014 17:09:47
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
 
 
#4
28.01.2014 16:47:11
у меня примерно таких таблиц 15 штук,
данные обновляются еженедельно
из этих таблиц сделаю другие отчеты
поэтому думаю что много ручных работ
сможете помочь мне, плз?
 
 
 
#5
29.01.2014 00:05:22
Пробовали записать удаление макрорекордером?
 
 
 
#6
29.01.2014 00:21:48
Юр, там МР не покатит, надо искать столбцы по названию. Но пример за автора лениво рисовать, да и кто знает, как у него расположены данные.
Я сам - дурнее всякого примера! ...
 
 
 
#7
29.01.2014 00:33:41
Массив заголовков, цикл по нему - find по строке и удаление.
Т.е. наоборот - find и копирование в новую книгу.
Изменено: Hugo - 29.01.2014 00:35:03
 
 
 
#8
29.01.2014 00:41:18
У меня другой вариант. Скрываем то, что нашли, видимые удаляем, скрытые отображаем. Так быстрей и технологичней. :)
Я сам - дурнее всякого примера! ...
 
 
 
#9
29.01.2014 00:44:08
Цитата
МР не покатит

Код
 Sub Макрос1()
    Range("A1").Select
    If ActiveCell <> "нужный" Then
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlToLeft
    End If
End Sub

и так 132*х раз
Зы что-то "код" барахлит -русские слова не любит
 
 
 
#10
29.01.2014 00:45:59
Та да! Николай, так вы все нужные столбцы удалите, кроме одного. :D
Я сам - дурнее всякого примера! ...
 
 
 
#11
29.01.2014 00:54:04
Сергей, ну or забыл ;)
 
 
 
#12
29.01.2014 01:02:16
Ага, только не or а and  :)
Я сам - дурнее всякого примера! ...
 
 
 
#13
29.01.2014 01:04:45
Да, скрытие-удаление лучше.
 
 
 
#14
29.10.2020 11:07:05
Что-то код не работает вообще.
Также нужно - удалить все столбцы кроме определенных.
Стандартно - заголовок в первой строчке.

Может кто-то поделится макросом? :)
 
 
 
#15
29.10.2020 12:05:23
mazersw, вы лучше тему создайте с файлом примером и вам помогут или поищите удаление строк/столбцов по условию
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#16
29.10.2020 13:57:30
Цитата
mazersw: удалить все столбцы кроме определенных
Данный код на активном листе удалит все столбцы с 1 по 100ый, кроме 5го, 8го и 12го
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#17
29.10.2020 15:37:06
Цитата
Jack Famous написал:
Данный код на активном листе удалит все столбцы с 1 по 100ый, кроме 5го, 8го и 12го
Код
   For col=1 To 100
      If col<>5 And col <> 8 And col <>12 Then Columns(col).Delete
   Next col
не станет этот код делать того что задекларировано (вы еще не наступали на эти грабли? удалит через один и оставит кучу лишних колонок)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#18
29.10.2020 15:51:47
Цитата
Ігор Гончаренко написал:
не станет этот код делать того что задекларировано
Циклом по столбцам надежней. Тоже встречался с косяками в применении And и Or. Не всегда декларации соответствуют фактам :)
 
 
 
#19
29.10.2020 15:58:46
Цитата
Ігор Гончаренко написал:
не станет этот код делать того что задекларировано
- он будет делать то что прописано :)
Цитата
_Igor_61 написал:
Циклом по столбцам надежней.
- это и есть цикл по столбцам.
Только идти нужно от 100 до 1!
 
 
 
#20
29.10.2020 16:03:14
Цитата
Ігор Гончаренко: не станет этот код делать того что задекларировано
блин точно - забыл совсем)))
Код
For col=100 To 1 Step-1
Изменено: Jack Famous - 29.10.2020 16:03:24
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#21
29.10.2020 16:06:40
Цитата
Jack Famous написал:
данный код на активном листе удалит все столбцы с 1 по 100ый, кроме 5го, 8го и 12го
спасибо!
 
 
 
#22
29.10.2020 16:15:53
Цитата
Hugo написал:
Только идти нужно от 100 до 1!
Не об этом я, а о том, что напарывался на то, что And и Or иногда косячат. То, что при удалении цикл обратно нужно делать - в курсе, :)
 
 
 
#23
29.10.2020 16:18:20
_Igor_61,
косячат не And и Or, а программисты, которые неумело их используют)

пройдемся мысленно по циклу удаления колонок с 1 по 100
на первом шаге с = 1 удаляется колонка №1 (все на листе сдвинулось влево, теперь бывшая колонка 2 стало колонкой 1)
на втором шаге с = 2  удаляем колонку 2 (бывшую 3), а текущая 1 (бывшая 2) УЖЕ благополучно пропущена этим кодом
и т.д....
Изменено: Ігор Гончаренко - 29.10.2020 16:26:39
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#24
29.10.2020 16:39:56
Код
'***************************************************************************************
' скопирует с указанного или активного листа колонки с названиями, указанными в массиве
'  Nms, по указанному адресу или на новый лист, добавленный в конце книги с данными
'
Sub SameColumnsCopy(Nms, Optional sws As Worksheet = Nothing, Optional trg As Range = Nothing)
  Dim rg As Range, urg As Range, c&
  If sws Is Nothing Then Set sws = ActiveSheet
  For c = LBound(Nms) To UBound(Nms)
    Set rg = sws.Cells.Find(cs(c), , xlValues, xlWhole, Searchformat:=False)
    If Not rg Is Nothing Then
      If urg Is Nothing Then Set urg = rg Else Set urg = Union(urg, rg)
    Else
      MsgBox "Дырка от бублика! Не найдено:" & vbLf & Nms(c)
    End If
  Next
  If Not urg Is Nothing Then
    If trg Is Nothing Then
      sws.Parent.Worksheets.Add after:=sws.Parent.Worksheets(sws.Parent.Worksheets.Count)
      urg.Copy sws.Parent.Worksheets(sws.Parent.Worksheets.Count).[a1]
    Else
      urg.Copy trg.Parent.Cells(1, trg.Column)
    End If
  End If
End Sub


Sub Test()
  SameColumnsCopy Array("Номер модели", "Код цвета", "Цена (оптовая)", "Цена (розничная)", _
  "Объем оперативной памяти", "Количество заказа")
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
Страницы: 1
Наверх