Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Копирование столбцов выбранных пользователем в ListBox в новую книгу
 
Добрый день решил создать новую тему, так как вопрос заключается в следующем:
Хочу чтобы чтобы копировались и вставлялись значения которые выбрал сам пользователь, я создал лист бокс с наименованием столбцов, теперь необходимо чтобы выбранные колонки копировались и вставлялись в новый файл, посмотрите пожалуйста так же саму структуру кода, я думаю точно можно что-то сократить или заменить (подробнее в файле примере)
И думаю здесь не помешали бы обработчики ошибок, вы как считаете?
Код
Sub Test()
 
Dim Dest As Workbook
Dim Source As Range
Dim ConstFilePath As String
Dim ConstFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim n As String
Dim Path As String
Dim arr1 As Variant
Dim arr2 As Variant
Dim cito As String
Dim putin As String
 
'Создаем два массива для формирования пути к файлам
arr1 = Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12")
arr2 = Array("В.Новгород", "Карелия", "Кубань1", "Кубань2", "Кубань3", "Мари", "Н.Новгород1", "Н.Новгород2", "Н.Новгород3", "Пенза", "Ростов1", "Ростов2", "Ростов3", "Тула", "Ярославль")
 
'инициализация формы
UserForm1.Show
 
q = 0
Path = "\\server6.tns\dzo\56\2018\"
cito = "56 2018."
MkDir Path & arr2(q)
For i = 0 To 9
'создаем путь к файлу который будет открыт
putin = Path & cito & arr1(i) & " " & arr2(q) & ".xlsx"
'открываем файл
Workbooks.Open (putin)
Application.DisplayAlerts = False
 
' Тут вместо значений А В С... нужно чтобы подбирались выбранные пользователем значения, и с этими значениями выполнялось копирование и вставка в новый файл
 
'A = WorksheetFunction.Match("TypeDoma", [ФЛ_Ф_056!a1:ww1], 0)
'B = WorksheetFunction.Match("TypUL", [ФЛ_Ф_056!a1:ww1], 0)
'C = WorksheetFunction.Match("LS", [ФЛ_Ф_056!a1:ww1], 0)
'j = WorksheetFunction.Match("VOL_IND", [ФЛ_Ф_056!a1:ww1], 0)
'D = WorksheetFunction.Match("N_SERV", [ФЛ_Ф_056!a1:ww1], 0)
'E = WorksheetFunction.Match("SQUARE", [ФЛ_Ф_056!a1:ww1], 0)
'F = WorksheetFunction.Match("ROOMS", [ФЛ_Ф_056!a1:ww1], 0)
'G = WorksheetFunction.Match("MAN_COUNT", [ФЛ_Ф_056!a1:ww1], 0)
'H = WorksheetFunction.Match("STATUS", [ФЛ_Ф_056!a1:ww1], 0)
 
 
Set Source = Nothing
On Error Resume Next
'изменить данную процедуру на выделение диапазонов выбранных из ListBox
Set Source = Union(Columns(A), Columns(B), Columns(C), Columns(j), Columns(D), Columns(E), Columns(F), Columns(G), Columns(H))
On Error GoTo 0
'копируем и вставляем выделенные диапазоны на нвоый лист
Set Dest = Workbooks.Add(xlWBATWorksheet)
    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).Select
        Application.CutCopyMode = False
    End With
 
'сохраняем под новым именем
With Dest
      .SaveAs Path & arr2(q) & "\" & cito & arr1(i) & ".xlsx"
On Error Resume Next
End With
'это я не знаю что
Dest.Close savechanges:=True
 
Application.DisplayAlerts = True
'закрываем книгу
ThisWorkbook.Close
'переходим на следующий файл
Next i
End Sub

 
Kentavrik7, не думаю, что смогу помочь Вам в Вашем вопрос, ибо сам нуб. Но, просто мысли вслух. В предыдущих темах, Вы изъявляли желание, чтобы макрос сам открывал из определенной папки Н-ное количество файлов, потом копировал из каждого определенные столбцы, создавал новый файл с этими столбцами и сохранял в отдельный файл под отдельным именем в отдельную папку. А теперь, Вы зачем-то вводите ЮзерФорм, где планируете вручную указывать нужные Вам столбцы/диапозоны. В итоге, если Вы сделаете цикл под этот код, Вам в каждом файле придется вручную вписывать эти самые столбцы/диапозоны. Если файлов будет, скажем 100, а я так понял из Ваших прошлых постов их немало, то Ваша автоматизированная работа превратиться в ручной ввод 100 диапозонов, прежде, чем код закончит свою работу. Вопрос, это зачем вообще все? Или я где-то ошибся в суждении?  
 
Paul Zealand, Всмысле вручную? Все шапки во всех файлах одинаковые, в исходном файле есть первая строка с наименованием столбцов (которые повторюсь во всех файлах одинакова) макрос который написали мне до этого работает. Он получается вытягивает те столбцы которые там прописаны. Теперь возникла идея что если вдруг будет необходимость проделать такую операцию с другими столбцами, чтобы не вводить в ручную:
Код
A = WorksheetFunction.Match("ТАКОЙ-ТО СТОЛБЕЦ", [ФЛ_Ф_056!a1:ww1], 0)
B = WorksheetFunction.Match("ИЛИ ТАКОЙ-ТО", [ФЛ_Ф_056!a1:ww1], 0)

А автоматически выбрать в лист боксе нужные столбцы и он уже их скопировал и вставил в новый файл, я не понимаю что вы имели ввиду под "100 ручных диапазонов" если они представлены в списке

Изменено: Kentavrik7 - 15 Мар 2019 14:20:08
 
Kentavrik7, ну смотрите, представим, что у Вас в папке 100 разных файлов. Вы запускаете макрос, который перебирает все эти 100 файлов и копирует из каждого какие-то столбцы в новый файл и сохраняет его в отдельную папку. Однако, Вы хотите, чтобы столбцы были не фиксированными, а была возможность выбрать в ЮзерФорме какие столбцы копировать. Получается, что ЮзерФорма у Вас выскочит ровно 100 раз, по количеству файлов и 100 раз спросит Вас какие столбцы в каждом из файлов копировать, и Вам надо будет 100 раз вручную указывать для каждого файла какие именно столбцы копировать. Разве нет? или как Вы видите весь процесс?
Изменено: Paul Zealand - 16 Мар 2019 07:57:47
 
Код
'Создаем два массива для формирования пути к файлам
arr1 = Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12")
arr2 = Array("В.Новгород", "Карелия", "Кубань1", "Кубань2", "Кубань3", "Мари", "Н.Новгород1", "Н.Новгород2", "Н.Новгород3", "Пенза", "Ростов1", "Ростов2", "Ростов3", "Тула", "Ярославль")

 А это зачем, или в папке куча других файлов?
"Все гениальное просто, а все простое гениально!!!"
 
Paul Zealand,нет один раз выбрали и из 100 файлов именно выбранные столбцы.  
 
Nordheim,это формирование имени файла, это их названия например:

56 2019.01 Ростов3
56 2019.02 Кубань
.
.
.
и т.д.
Настроил под себя

Необходимо, чтобы значения выбранные в листбоксе, заносились в массив, а потом как я предполагаю каждую переменную массива переносить в функцию
Код
WorksheetFunction.Match("Значение функции", , 0)
Изменено: Kentavrik7 - 18 Мар 2019 10:21:37
 
Kentavrik7, в общем я все равно не понимаю зачем Вам этот Бокс нужен. Если у Вас столбцы будут фиксирвоанными во всех 100 листах, то зачем их вообще выделять, когда можно их сразу определенить как переменные по имени шапки. То, что я Вам ранее предлагал. Вам лишь, остается это внутрь цикла закинуть, который будет помимо прочего перебирать файлы в папке и проделывать это с ними, вот собственно и все. Ну, в общем, сами смотрите )
Страницы: 1
Читают тему (гостей: 4)
Наверх