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

Вход

Регистрация

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

 

= Мир MS Excel/Скопировать выбранные столбцы через промежуток - Мир MS Excel

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

Добрый день!
Подскажите как прописать в коде копирование столбцов выборочно.
Дело в том что таких столбцов около 100 шт.
Определенной логики нет к которому моно привязать цикл (имхо)Книга1.xlsx
К сообщению приложен файл: 8597948.xlsm(10.3 Kb)


Сообщение отредактировал TEjgruig1jk - Пятница, 28.10.2022, 11:06
 
Ответить
СообщениеДобрый день!
Подскажите как прописать в коде копирование столбцов выборочно.
Дело в том что таких столбцов около 100 шт.
Определенной логики нет к которому моно привязать цикл (имхо)Книга1.xlsx

Автор - TEjgruig1jk
Дата добавления - 28.10.2022 в 10:12
Kuzmich Дата: Пятница, 28.10.2022, 12:08 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 699
Репутация: 152 ±
Замечаний: 0% ±

Excel 2003
Цитата
Определенной логики нет

пронумеруйте столбцы на листе1 в первой строке от 1 до 17 (от А до Q)
Создайте Лист2 и в первой строке введите номера тех столбцов,
которые вы желаете скопировать (А1=9, В1=12, С1=15 и т.д.)
При активном Листе1 запустить макрос
[vba]
Код
Sub iSelCopy()
     Range(Cells(1, 1), Cells(28, 17)).AdvancedFilter Action:=xlFilterCopy, _
     CopyToRange:=ThisWorkbook.Worksheets("Лист2").Range("A1").Resize(, 4), Unique:=False
End Sub
[/vba]
 
Ответить
Сообщение
Цитата
Определенной логики нет

пронумеруйте столбцы на листе1 в первой строке от 1 до 17 (от А до Q)
Создайте Лист2 и в первой строке введите номера тех столбцов,
которые вы желаете скопировать (А1=9, В1=12, С1=15 и т.д.)
При активном Листе1 запустить макрос
[vba]
Код
Sub iSelCopy()
     Range(Cells(1, 1), Cells(28, 17)).AdvancedFilter Action:=xlFilterCopy, _
     CopyToRange:=ThisWorkbook.Worksheets("Лист2").Range("A1").Resize(, 4), Unique:=False
End Sub
[/vba]

Автор - Kuzmich
Дата добавления - 28.10.2022 в 12:08
TEjgruig1jk Дата: Пятница, 28.10.2022, 12:22 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 20% ±

Kuzmich, все сделал не получилось вот файл
К сообщению приложен файл: 6901409.xlsm(17.2 Kb)
 
Ответить
СообщениеKuzmich, все сделал не получилось вот файл

Автор - TEjgruig1jk
Дата добавления - 28.10.2022 в 12:22
TEjgruig1jk Дата: Пятница, 28.10.2022, 12:32 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 20% ±

Kuzmich, а можно ли это реализовать циклом? просто немогу понять как в цикле прописать список диапазонов I13:I28 ; I13L:L28; O13:O28 ...итп 100 раз
 
Ответить
СообщениеKuzmich, а можно ли это реализовать циклом? просто немогу понять как в цикле прописать список диапазонов I13:I28 ; I13L:L28; O13:O28 ...итп 100 раз

Автор - TEjgruig1jk
Дата добавления - 28.10.2022 в 12:32
Kuzmich Дата: Пятница, 28.10.2022, 12:35 | Сообщение № 5
Группа: Проверенные
Ранг: Ветеран
Сообщений: 699
Репутация: 152 ±
Замечаний: 0% ±

Excel 2003
Ваш файл серьезно поврежден.
К сообщению приложен файл: 8597948_1.xlsm(17.8 Kb)
 
Ответить
СообщениеВаш файл серьезно поврежден.

Автор - Kuzmich
Дата добавления - 28.10.2022 в 12:35
TEjgruig1jk Дата: Пятница, 28.10.2022, 12:41 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 20% ±

Kuzmich, прикрепил файл без макроса
К сообщению приложен файл: __.xlsx(11.2 Kb)
 
Ответить
СообщениеKuzmich, прикрепил файл без макроса

Автор - TEjgruig1jk
Дата добавления - 28.10.2022 в 12:41
TEjgruig1jk Дата: Пятница, 28.10.2022, 13:02 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 20% ±

Kuzmich, возможно ли в коде в этом коде прописать список диапазонов (типа Range(" I13:I28 ; I13L:L28; O13:O28 ");

[vba]
Код
Sub Test3()
'Объявляем переменную
Dim myRange As Range
'Присваиваем диапазон ячеек
Set myRange = Range("C6:E8")
'Присваиваем ячейкам рабочего листа
'значения ячеек переменной диапазона
Range("A1:C3") = myRange.Value
MsgBox "Пауза"
'Копирование диапазона переменной
'и вставка его на рабочий лист
'с указанием начальной ячейки
myRange.Copy Range("E1")
MsgBox "Пауза"
'Копируем и вставляем часть
'диапазона из переменной
myRange.Range("A2:C2").Copy Range("E11")
End Sub
[/vba]


Сообщение отредактировал Serge_007 - Пятница, 28.10.2022, 13:27
 
Ответить
СообщениеKuzmich, возможно ли в коде в этом коде прописать список диапазонов (типа Range(" I13:I28 ; I13L:L28; O13:O28 ");

[vba]
Код
Sub Test3()
'Объявляем переменную
Dim myRange As Range
'Присваиваем диапазон ячеек
Set myRange = Range("C6:E8")
'Присваиваем ячейкам рабочего листа
'значения ячеек переменной диапазона
Range("A1:C3") = myRange.Value
MsgBox "Пауза"
'Копирование диапазона переменной
'и вставка его на рабочий лист
'с указанием начальной ячейки
myRange.Copy Range("E1")
MsgBox "Пауза"
'Копируем и вставляем часть
'диапазона из переменной
myRange.Range("A2:C2").Copy Range("E11")
End Sub
[/vba]

Автор - TEjgruig1jk
Дата добавления - 28.10.2022 в 13:02
Kuzmich Дата: Пятница, 28.10.2022, 13:12 | Сообщение № 8
Группа: Проверенные
Ранг: Ветеран
Сообщений: 699
Репутация: 152 ±
Замечаний: 0% ±

Excel 2003
Цитата
а можно ли это реализовать циклом?

[vba]
Код
Sub iCopySelColumns()         'запускаем при активном листе Лист1
Dim i As Long
Dim n As Integer
Dim iLastRow As Long
Dim arr
Dim iCol As Range
  arr = Array(9, 12, 15, 17)    'выбранные столбцы
  n = 1
With Worksheets("Лист2")
   .Cells.Clear
For i = 0 To UBound(arr)
     Set iCol = Rows(1).Find(arr(i), , xlValues, xlWhole)
   If Not iCol Is Nothing Then
     Range(Cells(1, iCol.Column), _
     Cells(28, iCol.Column)).Copy .Cells(1, n)
     n = n + 1
   End If
Next i
.Activate
End With
End Sub
[/vba]
 
Ответить
Сообщение
Цитата
а можно ли это реализовать циклом?

[vba]
Код
Sub iCopySelColumns()         'запускаем при активном листе Лист1
Dim i As Long
Dim n As Integer
Dim iLastRow As Long
Dim arr
Dim iCol As Range
  arr = Array(9, 12, 15, 17)    'выбранные столбцы
  n = 1
With Worksheets("Лист2")
   .Cells.Clear
For i = 0 To UBound(arr)
     Set iCol = Rows(1).Find(arr(i), , xlValues, xlWhole)
   If Not iCol Is Nothing Then
     Range(Cells(1, iCol.Column), _
     Cells(28, iCol.Column)).Copy .Cells(1, n)
     n = n + 1
   End If
Next i
.Activate
End With
End Sub
[/vba]

Автор - Kuzmich
Дата добавления - 28.10.2022 в 13:12
Serge_007 Дата: Пятница, 28.10.2022, 13:29 | Сообщение № 9
Группа: Админы
Ранг: Местный житель
Сообщений: 15538
Репутация: 2558 ±
Замечаний: ±

Excel 2016
прописать список диапазонов (типа Range(" I13:I28 ; I13L:L28; O13:O28 ")
[vba]
Код
Application.Union(Range("Range1"), Range("Range2"))
[/vba]


ЮMoney:41001419691823 | WMR:126292472390
 
Ответить
Сообщение
прописать список диапазонов (типа Range(" I13:I28 ; I13L:L28; O13:O28 ")
[vba]
Код
Application.Union(Range("Range1"), Range("Range2"))
[/vba]

Автор - Serge_007
Дата добавления - 28.10.2022 в 13:29
TEjgruig1jk Дата: Пятница, 28.10.2022, 13:36 | Сообщение № 10
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 20% ±

Serge_007, т.е нужно будет присваивать Range1 ( I13:I28) Range2 (I13L:L28) Range3(O13:O28 ) итд
тогда получится нужно будет прописать таких 100 строк
 
Ответить
СообщениеSerge_007, т.е нужно будет присваивать Range1 ( I13:I28) Range2 (I13L:L28) Range3(O13:O28 ) итд
тогда получится нужно будет прописать таких 100 строк

Автор - TEjgruig1jk
Дата добавления - 28.10.2022 в 13:36
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Скопировать выбранные столбцы через промежуток (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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