Пытаюсь решть такую задачу: Есть предзаполненный файл, форма КС-2 (во вложении). НАдо сгененрировать много таких файлов (допустим 400), в каждом меняется только поле F15 (название строительного объекта), номер документа в ячейке BA25, дата составления BL25. Файл должен сохранятся под уникальным именем, как в поле F15 (название строительного объекта). Данные хранаятся в файле Data.xls З адача, сделать на каждый объект( каждый адрес) по отдельному файту с соотвующим полями.
Как я это вижу: для начала надо задать массив названий строительного объекта и массив адресов.
Sub CS() 'массив (-ы) адресов, номеров документов и названий файлов: Dim FullSiteName (1 to 385) As string Dim DocNum (1 to 385) As integer
'цикл на количество строительных адресов. For index = 1 to 385 FullSiteName(index) = КАК ПРИСВОИТЬ ЗНАЧЕНИЕ из каждой следующей ячейки? DocNum(index) = КАК ПРИСВОИТЬ ЗНАЧЕНИЕ из каждой следующей ячейки?
Next index
End Sub
То естья я думаю заполнить массив алресами и номерами документов, потом вставлять эти значения опять в цикле в ф файл и сохранять его под уникальным именем.
я то то не так делаю? как "загнать" в массив данные из таблицы?
Руслан.
Здравствуйте!
Пытаюсь решть такую задачу: Есть предзаполненный файл, форма КС-2 (во вложении). НАдо сгененрировать много таких файлов (допустим 400), в каждом меняется только поле F15 (название строительного объекта), номер документа в ячейке BA25, дата составления BL25. Файл должен сохранятся под уникальным именем, как в поле F15 (название строительного объекта). Данные хранаятся в файле Data.xls З адача, сделать на каждый объект( каждый адрес) по отдельному файту с соотвующим полями.
Как я это вижу: для начала надо задать массив названий строительного объекта и массив адресов.
Sub CS() 'массив (-ы) адресов, номеров документов и названий файлов: Dim FullSiteName (1 to 385) As string Dim DocNum (1 to 385) As integer
'цикл на количество строительных адресов. For index = 1 to 385 FullSiteName(index) = КАК ПРИСВОИТЬ ЗНАЧЕНИЕ из каждой следующей ячейки? DocNum(index) = КАК ПРИСВОИТЬ ЗНАЧЕНИЕ из каждой следующей ячейки?
Next index
End Sub
То естья я думаю заполнить массив алресами и номерами документов, потом вставлять эти значения опять в цикле в ф файл и сохранять его под уникальным именем.
я то то не так делаю? как "загнать" в массив данные из таблицы?
А зачем загружать данные в массив, если можно список обрабатывать и прямо на листе? Зачем делать несколько массивов? И где там даты?
Впрочем...
[vba]
Код
Sub test()
If MsgBox("Начать массовое сохранение файлов?", vbYesNo + vbQuestion + vbDefaultButton2) <> vbYes Then Exit Sub End If
Dim i, lr, cnt, a(), wb As Workbook, sh as Worksheet cnt = 0 ' в текущем файле должен быть лист с именем "Sheet1", с данными в первых двух столбцах lr = ThisWorkbook.Worksheets("Sheet1").Cells.SpecialCells(xlLastCell).Row a = ThisWorkbook.Worksheets("Sheet1").Range(Cells(1, 1), Cells(lr, 2)).Value
Application.ScreenUpdating = False Application.DisplayAlerts = False ' в текущем каталоге должен лежать файл КС-2.xls с образцом формы Set wb = Workbooks.Open(ThisWorkbook.Path & "\КС-2.xls") Set sh = wb.Sheets(1)
For i = 1 To lr If Len(a(i, 1)) > 0 Then sh.Range("F15").Value = a(i, 1) sh.Range("BA25").Value = "'" & a(i, 2) sh.Range("BL25").Value = Format(Date, "Short Date") wb.SaveAs (ThisWorkbook.Path & "\" & a(i, 1)), xlOpenXMLWorkbook cnt = cnt + 1 End If Next
P.S. И да, читайте Правила - необязательно кросспостить свой вопрос на все сайты-форумы по Excel, особенно на сайты-друзья...
А зачем загружать данные в массив, если можно список обрабатывать и прямо на листе? Зачем делать несколько массивов? И где там даты?
Впрочем...
[vba]
Код
Sub test()
If MsgBox("Начать массовое сохранение файлов?", vbYesNo + vbQuestion + vbDefaultButton2) <> vbYes Then Exit Sub End If
Dim i, lr, cnt, a(), wb As Workbook, sh as Worksheet cnt = 0 ' в текущем файле должен быть лист с именем "Sheet1", с данными в первых двух столбцах lr = ThisWorkbook.Worksheets("Sheet1").Cells.SpecialCells(xlLastCell).Row a = ThisWorkbook.Worksheets("Sheet1").Range(Cells(1, 1), Cells(lr, 2)).Value
Application.ScreenUpdating = False Application.DisplayAlerts = False ' в текущем каталоге должен лежать файл КС-2.xls с образцом формы Set wb = Workbooks.Open(ThisWorkbook.Path & "\КС-2.xls") Set sh = wb.Sheets(1)
For i = 1 To lr If Len(a(i, 1)) > 0 Then sh.Range("F15").Value = a(i, 1) sh.Range("BA25").Value = "'" & a(i, 2) sh.Range("BL25").Value = Format(Date, "Short Date") wb.SaveAs (ThisWorkbook.Path & "\" & a(i, 1)), xlOpenXMLWorkbook cnt = cnt + 1 End If Next
Почему то останавливается.. а как бы Вы посоветовали сделать? Дату ставим текущую. Список обрабатывать (менять) не нужно. Т.е. надо "сгенерить" КС-2 по количеству строительных объектов, а список объектов есть в виде списка.
А зачем загружать данные в массив, если можно список обрабатывать и прямо на листе? Зачем делать несколько массивов? И где там даты?
Впрочем...
Андрей, спасибо за ответ.
[img][/img]
Почему то останавливается.. а как бы Вы посоветовали сделать? Дату ставим текущую. Список обрабатывать (менять) не нужно. Т.е. надо "сгенерить" КС-2 по количеству строительных объектов, а список объектов есть в виде списка.
"Обработать" список - не означает "изменить его". Подразумевается, что нет необходимости записывать список в массив(ы), если у нас и так лист - это массив. Объектов.
"Останавливается"... а с какого перепугу вы процедуру поместили куда-то "далеко-далеко" в надстройку? Где это сказано было? Там специально для таких деятелей - указано в комментарии, где процедура должна находиться - "В ТЕКУЩЕЙ КНИГЕ СО СПИСКОМ", т.е. в этом вашем файле data.xls
"Обработать" список - не означает "изменить его". Подразумевается, что нет необходимости записывать список в массив(ы), если у нас и так лист - это массив. Объектов.
"Останавливается"... а с какого перепугу вы процедуру поместили куда-то "далеко-далеко" в надстройку? Где это сказано было? Там специально для таких деятелей - указано в комментарии, где процедура должна находиться - "В ТЕКУЩЕЙ КНИГЕ СО СПИСКОМ", т.е. в этом вашем файле data.xlsAndreTM
Skype: andre.tm.007 Donate: Qiwi: 9517375010
Сообщение отредактировал AndreTM - Вторник, 13.06.2017, 07:12