Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  | Правила  

Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » VBA - Копирование n столбцов на новый лист с заданными заголовками

Ответить
Настройки темы
VBA - Копирование n столбцов на новый лист с заданными заголовками

Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать


Как реализовать функцию на море столбцов?
А то переписывать одно и тоже под конкретную задачу не хорошо
Код: Выделить весь код
Public Sub Copy4Columns(Sheets_ As String, column1 As String, column2 As String, column3 As String, column4 As String) 'копируем на новый лист 4 столбца
    Application.ScreenUpdating = False
    If ActiveSheet.Index > 1 Then
        Sheets.Add Before:=Sheets(ActiveSheet.Index)
    Else
        Sheets.Add After:=Sheets(ActiveSheet.Index)
    End If
    ActiveSheet.Name = Sheets_
    With Worksheets(ActiveSheet.Index - 1)
        oboz = .Cells.Find(What:=column1, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        .Columns(oboz).Copy
        Columns(1).Select
        ActiveSheet.Paste
        nop = .Cells.Find(What:=column2, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        .Columns(nop).Copy
        Columns(2).Select
        ActiveSheet.Paste
        razr = .Cells.Find(What:=column3, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        .Columns(razr).Copy
        Columns(3).Select
        ActiveSheet.Paste
        Tpz = .Cells.Find(What:=column4, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        .Columns(Tpz).Copy
        Columns(4).Select
        ActiveSheet.Paste
    End With
    Application.ScreenUpdating = True
End Sub

Отправлено: 15:33, 04-05-2017

 

Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать


blackeangel, добавили лист по Sheets.Add() — сразу берите возвращаемую методом ссылку на новый рабочий лист и работайте с ней. И никаких последующих игр с ActiveSheet и Worksheets(ActiveSheet.Index - 1).

Будет проще, если Вы поясните, что означает:
Код: Выделить весь код
        oboz = .Cells.Find(What:=column1, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        .Columns(oboz).Copy
        Columns(1).Select
        ActiveSheet.Paste
И пример вызова процедуры покажите.

Отправлено: 16:52, 04-05-2017 | #2



Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети.

Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля.


Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать


Цитата Iska:
blackeangel, добавили лист по Sheets.Add() — сразу берите возвращаемую методом ссылку на новый рабочий лист и работайте с ней. И никаких последующих игр с ActiveSheet и Worksheets(ActiveSheet.Index - 1).

Будет проще, если Вы поясните, что означает:
Код: Выделить весь код
        oboz = .Cells.Find(What:=column1, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        .Columns(oboz).Copy
        Columns(1).Select
        ActiveSheet.Paste
И пример вызова процедуры покажите.
1. Не понял про sheet.add
2. Ищем столбец на предыдущем листе по его заголовку, копируем весь столбец и вставляем на новый
3. Пример вызова
Copy4Columns("Имя_Нового_Листа","имя_столбца1","Имя_столбца2","Имя_столбца3","имя_столбца4")

Отправлено: 16:56, 04-05-2017 | #3


Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать


Цитата blackeangel:
2. Ищем столбец на предыдущем листе по его заголовку, »
Вот хрен бы догадался .


Попробуйте так:
Скрытый текст
Код: Выделить весь код
Option Explicit

Sub SampleCall()
    Copy4Columns "Имя_Нового_Листа", Array("имя_столбца1", "Имя_столбца2", "Имя_столбца3", "имя_столбца4")
End Sub

Public Sub Copy4Columns(strNewWorksheetName As String, arrTitles As Variant)
    Dim objSourceWorksheet As Worksheet
    Dim objDestWorksheet As Worksheet
    
    Dim strTitle As Variant
    
    Dim objSourceRange As Range
    Dim objDestRange As Range
    
    
    Application.ScreenUpdating = False
    
    
    Set objSourceWorksheet = ActiveSheet
    
    If objSourceWorksheet.Index > 1 Then
        Set objDestWorksheet = Sheets.Add(Before:=objSourceWorksheet)
    Else
        Set objDestWorksheet = Sheets.Add(After:=objSourceWorksheet)
    End If
    
    
    With objDestWorksheet
        .Name = strNewWorksheetName
        
        For Each strTitle In arrTitles
            Set objSourceRange = objSourceWorksheet.UsedRange.Find(What:=strTitle, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)
            
            If Not objSourceRange Is Nothing Then
                If .UsedRange.Count = 1 Then
                    Set objDestRange = .UsedRange.EntireColumn
                Else
                    Set objDestRange = .UsedRange.Offset(ColumnOffset:=1).EntireColumn
                End If
                
                If Not objSourceRange.EntireColumn.Copy(objDestRange) Then
                    Debug.Print "Can't copy column [" & objSourceRange.EntireColumn.Address(External:=True) & "] into worksheet [" & .Name & "]."
                End If
            Else
                Debug.Print "Can't find value [" & strTitle & "] in worksheet [" & objSourceWorksheet.Name & "]."
            End If
        Next
    End With
    
    Set objDestWorksheet = Nothing
    Set objSourceWorksheet = Nothing
    
    Application.ScreenUpdating = True
End Sub

Цитата blackeangel:
1. Не понял про sheet.add »
Выделил в коде. Точно так же мы сразу запоминаем ссылку на текущий активный рабочий лист в переменной objSourceWorksheet и далее работаем именно с ней, независимо от того, какой лист в процессе может стать активным.

Отправлено: 17:32, 04-05-2017 | #4


Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать


Iska, не, так кривоватенько)
во первых, заменяет последним столбцом все предыдущие
Второе, берет не нужный лист, тк мне надо index-1, но это бог с ним, не проблема, а вот с первым беда.
По первой проблеме-видимо надо завязываться на кол-во элементов массива заголовков. И вставлять их по очереди в определенный столбец, который равен порядковому номеру заголовка столбца+1 в массиве. Как это реализовать в коде - не допер, тк не понятно где кто копируется и вставляется.
И ещё вопрос, как вставить лист, так чтоб он был неактивным?

Последний раз редактировалось blackeangel, 05-05-2017 в 12:21.


Отправлено: 07:21, 05-05-2017 | #5


Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать


Мой вариант решения задачи таков:
Код: Выделить весь код
Public Sub Copy4Columns2(Sheets_ As String, arrTitles As Variant) 'копируем на новый лист n столбцов
Dim strTitle As Variant
    Application.ScreenUpdating = False
    If ActiveSheet.Index > 1 Then
        Sheets.Add Before:=Sheets(ActiveSheet.Index)
    Else
        Sheets.Add After:=Sheets(ActiveSheet.Index)
    End If
    ActiveSheet.Name = Sheets_
    i = 0
For Each strTitle In arrTitles
i = i + 1
    With Worksheets(ActiveSheet.Index - 1)
        oboz = .Cells.Find(What:=strTitle, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        .Columns(oboz).Copy
        Columns(i).Select
        ActiveSheet.Paste
    End With
Next
    Application.ScreenUpdating = True
End Sub

Отправлено: 12:53, 05-05-2017 | #6


Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать


Цитата blackeangel:
во первых, заменяет последним столбцом все предыдущие »
Вообще-то не так . Но ошибка присутствует, надо заменить в ветви Else:
Код: Выделить весь код
Set objDestRange = .UsedRange.Offset(ColumnOffset:=1).EntireColumn
на:
Код: Выделить весь код
Set objDestRange = .Columns.Item(.UsedRange.Columns.Count).Offset(ColumnOffset:=1).EntireColumn
Цитата blackeangel:
Второе, берет не нужный лист, тк мне надо index-1, »
Где берёт? От чего берёт? Поясните словами, где и что нужно сделать.

Цитата blackeangel:
По первой проблеме-видимо надо завязываться на кол-во элементов массива заголовков. И вставлять их по очереди в определенный столбец, который равен порядковому номеру заголовка столбца+1 в массиве. »
Можно и так. Но проще ориентироваться на количество столбцов уже заполненной части целевого Рабочего листа, то есть — танцевать от .UsedRange.Columns (поскольку мы заполняем от самого первого столбца — этого будет достаточно).

Цитата blackeangel:
И ещё вопрос, как вставить лист, так чтоб он был неактивным? »
Никак. И я Вам написал выше — нужно прекращать порочную практику увязки кода с активностью Рабочих листов и книг. Вошли в код — сразу запомнили ссылку на активный Рабочий лист в переменной, если он Вам понадобится. Добавляете лист — сразу запоминаете возвращаемую методом ссылку в переменной. И далее работаете только с этими объектными переменными. А Вы опять Copy-Paste с увязкой на ActiveSheet:
Код: Выделить весь код
        .Columns(oboz).Copy
        Columns(i).Select
        ActiveSheet.Paste
продолжаете пользовать.

Отправлено: 18:40, 05-05-2017 | #7


Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать


Iska, последний вопрос был общим, не относящийся к данной теме.
На счёт порочного круга - мне так понятно что происходит, а ваш код темный лес, ибо знаний в этом направлении у меня нет вообще.
Цитата:
Где берёт? От чего берёт? Поясните словами, где и что нужно сделать.
У вас запоминает последний активный лист, а мне он не нужен. Берется лист до него. Например, есть 2 листа, последний активный, а данные берутся с первого. У вас, с последнего активного, как я понимаю ваши слова.

Последний раз редактировалось blackeangel, 05-05-2017 в 21:10.


Отправлено: 20:57, 05-05-2017 | #8


Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать


Цитата blackeangel:
активный лист, а мне он не нужен. Берется лист до него. »
А в чём смысл копирования в новый лист не с активного Рабочего листа?

Цитата blackeangel:
а ваш код темный лес, ибо знаний в этом направлении у меня нет вообще. »
Спрашивайте, поясню.

Можете также, временно закомментировав Application.ScreenUpdating, прогнать код по шагам под отладчиком по F8, просматривая по ходу движения потребное хоть ручками в окне Immediate, хоть в окне Watches:
Скрытый текст

Отправлено: 21:36, 05-05-2017 | #9



Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » VBA - Копирование n столбцов на новый лист с заданными заголовками

Участник сейчас на форуме Участник сейчас на форуме Участник вне форума Участник вне форума Автор темы Автор темы Шапка темы Сообщение прикреплено

Похожие темы
Название темы Автор Информация о форуме Ответов Последнее сообщение
2010 - [решено] Excel 2010 фильтр 1 и 2 листа скопировать на новый лист The Off Microsoft Office (Word, Excel, Outlook и т.д.) 30 03-08-2013 09:18
2007 - Копирование Строки на Другой лист. HomaOne Microsoft Office (Word, Excel, Outlook и т.д.) 10 19-07-2013 22:07
2010 - [решено] Excel - копирование выбранных строк на другой лист linkwy Microsoft Office (Word, Excel, Outlook и т.д.) 3 16-08-2012 21:14
VBS/WHS/JS - Как открыть окно проводника с ЗАДАННЫМИ координатами расположения на рабочем столе? Alex Cop Программирование и базы данных 3 18-07-2008 12:28




 
Переход