| Fantastish |
27-05-2016 10:08 2638016 |
Автоматизация экспорта данных из Excel
Вложений: 1
Доброго.
Прощу помощи в решении вот такой задачи:
Есть файл Excel с внутренними листами, необходимо обрабатывать Лист под названием "Данные"
В данном листе необходимо проверить столбец "ФИО" и выбрать из него (если возможны два условия) пустую ячейку или по слову "Свободный"
Выгрузить выбранные данные в новый файл сохраняя структуру
Файл можно перетирать, хотелось бы скрипт, чтобы потом его можно было закинуть в планировщик.
Большое спасибо.
|
vbs-скрипт
Код:
Book = "Z:\форум.xlsx"
BookOut="Z:\форум_свобода.xlsx"
List = "Данные" ' Имя листа с данными
Col1 = "A" ' Первая колонка с данными
Col2 = "H" ' Последняя колонка с данными
Col0 = "D" ' Колонка с данными для анализа
Row1 = 2 ' Первая строка с данными
Set FSO = CreateObject("Scripting.FileSystemObject")
Set XL = CreateObject("Excel.Application")
XL.Visible = True
XL.Workbooks.Open Book
XL.Sheets(List).Select
C1 = XL.Range(Col1 + "1").Column
C2 = XL.Range(Col2 + "1").Column
C0 = XL.Range(Col0 + "1").Column
R1 = Col1 + CStr(Row1)
i = Row1 - 1
Do
i = i + 1
L = False
For j = C1 To C2
L = L Or XL.Range(R1).Offset(i - Row1, j - C1) <> ""
Next
If Not L Then Exit Do
Loop
Row2 = i - 1
' Dim Mas As Variant
Mas = XL.Range(R1 + ":" + Col2 + CStr(Row2))
XL.Range(R1 + ":" + Col2 + CStr(Row2)).ClearContents
N1 = LBound(Mas, 1)
N2 = UBound(Mas, 1)
N22 = UBound(Mas, 2) - LBound(Mas, 1)
R22 = Col1 + CStr(Row1) + ":" + Col2 + CStr(Row1)
ReDim Mas1(N22)
NN = 0
For i = N1 To N2
j = C0 - C1 + N1
If (Len(Trim(Mas(i, j))) = 0) Or (InStr(1, Mas(i, j), "Свобод") <> 0) Then
For jj = 0 To N22
Mas1(jj) = Mas(i, jj + N1)
Next
XL.Range(R22).Offset(NN, 0) = Mas1
NN = NN + 1
' MsgBox CStr(i) + " " + Mas(i, j)
End If
Next
XL.Range("A1").Select
If FSO.FileExists(BookOut) Then FSO.DeleteFile(BookOut)
XL.ActiveWorkbook.SaveAs BookOut
XL.Quit
|
Цитата:
Цитата megaloman
XL. ActiveWorkbook.SaveAs BookOut »
|
Как тут пробел затесался? |
Iska, Вкрался. Исправил. Но, самое интересное, работало нормально.
|
Цитата:
Цитата megaloman
Но, самое интересное, работало нормально. »
|
Странно. Я, впрочем, не проверял. |
| Fantastish |
30-05-2016 12:43 2638737 |
Доброго дня. Спасибо за скрипт.
Но у меня еще просьба, попробовал оптимизировать скрипт под свой файл, получил ошибку
Скрытый текст
List = "Данные" ' Имя листа с данными
Col1 = "C" ' Первая колонка с данными
Col2 = "L" ' Последняя колонка с данными
Col0 = "F" ' Колонка с данными для анализа
Row1 = 2 ' Первая строка с данными
Что в 28 строке символ 13 - несоответствие типа |
Fantastish, А что в 28 строке скрипта? Упакуйте или переименуйте его в тхт, пришлите, надо смотреть. А еще лучше с Вашим ексел-файлом. Упакуйте, можете с паролем, пароль в личное сообщение. То, что Вы выложили - похоже ошибочно. У вас в имени колонки "С" русская буква.
|
| Fantastish |
30-05-2016 13:31 2638748 |
Отправил в пм, спасибо
|
Fantastish, Ваша ситуация оказалась сложнее.
1. В исходном файле несколько листов с взаимными связями
2. Формулы не всегда выдают корректный результат
Вот изменённый код с учетом особенностей Вашей таблицы.
Код:
Book = "Z:\Данные2.xlsx"
BookOut="Z:\форум_свобода.xlsx"
List = "Данные" ' Имя листа с данными
Col1 = "A" ' Первая колонка с данными
Col2 = "R" ' Последняя колонка с данными
Col0 = "F" ' Колонка с данными для анализа
Row1 = 2 ' Первая строка с данными
Set FSO = CreateObject("Scripting.FileSystemObject")
Set XL = CreateObject("Excel.Application")
With XL
.Visible = True
.Workbooks.Open Book
.Sheets(List).Select
.Range(Col1+":"+Col2).Copy
aaa=.Range(Col1+":"+Col2).PasteSpecial(-4163, -4142, False, False)
.Sheets(List).Copy
.Windows(FSO.GetFile(Book).Name).Close (False)
C1 = .Range(Col1 + "1").Column
C2 = .Range(Col2 + "1").Column
C0 = .Range(Col0 + "1").Column
R1 = Col1 + CStr(Row1)
i = Row1 - 1
Do
i = i + 1
L = False
For j = C1 To C2
On Error Resume Next
RR1=.Range(R1).Offset(i - Row1, j - C1)
If Err.Number <> 0 Then
RR1="Н/Д"
.Range(R1).Offset(i - Row1, j - C1)=RR1
End If
L = L Or RR1 <> ""
Next
If Not L Then Exit Do
Loop
Row2 = i - 1
' Dim Mas As Variant
Mas = .Range(R1 + ":" + Col2 + CStr(Row2))
.Range(R1 + ":" + Col2 + CStr(Row2)).ClearContents
N1 = LBound(Mas, 1)
N2 = UBound(Mas, 1)
N22 = UBound(Mas, 2) - LBound(Mas, 1)
R22 = Col1 + CStr(Row1) + ":" + Col2 + CStr(Row1)
ReDim Mas1(N22)
NN = 0
For i = N1 To N2
j = C0 - C1 + N1
If (Len(Trim(Mas(i, j))) = 0) Or (InStr(1, Mas(i, j), "Свобод") <> 0) Then
For jj = 0 To N22
Mas1(jj) = Mas(i, jj + N1)
Next
.Range(R22).Offset(NN, 0) = Mas1
NN = NN + 1
' MsgBox CStr(i) + " " + Mas(i, j)
End If
Next
.Range("A1").Select
If FSO.FileExists(BookOut) Then FSO.DeleteFile(BookOut)
.ActiveWorkbook.SaveAs BookOut
.Quit
End With
1. Формируется новая таблица с одним листом безо всяких формул
2. Игнорируются ошибки при работе Ваших формул
|
| Fantastish |
30-05-2016 17:54 2638843 |
Огромное спасибо
Вопрос:
параметр .Visible = True - определяет в silent режиме откроется приложение или нет?
и еще одна глупая возможность, может ли скрипт в процессе обработки, удалять (подчищать пустые строки)?
|
Цитата:
Цитата Fantastish
параметр .Visible = True - определяет в silent режиме откроется приложение или нет? »
|
Определяет, будет ли окно приложения-сервера видимым или скрытым. |
Время: 06:35.
© OSzone.net 2001-
