Обещал рассказать про разработанные решения - рассказываю.
Автоматизируй_это_1
Одной из первых была задача автоматизировать пополнение базы данных (БД) составов пластовой смеси. Кто бы мог предположить сколько подобных задач впереди
Вкратце - добываемый на нашем предприятии флюид имеет сложный состав - как углеводороды, так и не-углеводороды. За всем этим зоопарком необходим контроль - для него и ведется БД, о которой идет речь.
Вот как она выглядит.
Нехитрая электронная табличка. В столбцах - компоненты, в строках - скважины. Каждой скважине отведен свой блок строк, внутри которого - данные по химическим анализам проб с этой скважины в хронологическом порядке. Уверен, вы похожие таблицы ведете и у себя.
А вот как выглядят новые данные.
На каждую скважину - такой вот файлик с кучей данных, из которых нам нужны далеко не все. Файлики приходят группами. Как только лаборатория закончит анализ имеющихся проб - пуляют нам с десяток результатов анализов. И делайте с ними что хотите. Мы хотим - занести в БД.
Раньше это делалось руками (да-да, прям как у вас). Открыли новый файл - поочередно методом ctrl+c --> ctrl+v перенесли в БД - попили чай - перешли к следующему файлу. (Ну чай, конечно, по желанию). Короче - боль.
Как это автоматизировать? Т.к. данные поступают пакетом, нужно сразу считать весь пакет - ведь нет смысла обрабатывать файлы по одному, заставляя пользователя тратить время. Файлы - типовые, стало быть нужен код, который из нужных ячеек возьмет нужные данные и вставит в нужные места БД. Сказано - сделано.
Поехали.
Разобьем задачу на под-задачи:
1) Нужно получить массив файлов, с которыми будем работать - спрашиваем у пользователя путь, пробегаемся по всем файлам
2) Из каждого файла нужно записать в массив требуемые нам данные
3) Понять, куда данные следует вставить в нашу БД.
4) И самое простое - вставить скопированные данные.
Решаем.
1) Получаем массив файлов из папки:
Set fs = CreateObject("Scripting.FileSystemObject")
FolderName = Application.InputBox(prompt:="Укажите адрес папки с файлами для импортирования в базу", Default:="D:\Новые составы\", Type:=2)
Set MySource = fs.GetFolder(FolderName)
For Each file In MySource.Files
....
Next file
Этот цикл пробегает по всем файлам в указанной пользователем папке и с каждым из них внутри цикла можно что-то сделать. Тут не очень удобный способ "вопрошания" папки - но это одно из первых моих user-friendly творений - поэтому код коряв.
Здесь же, кстати, можно дважды выстрелить себе в ногу. Первый момент - если юзер ничего не укажет в инпут-боксе. Поэтому нужно добавить условие:
If FolderName = "False" Then Exit Sub
А второй момент угадайте в комментариях.
2) Берем нужное из файла:
Если эти в лоб - то можно каждый файл открыть. Этот код прекрасно запишется макрорекодером, но будет работать долго. Я нашел более элегантное решение - метод ExecuteExcel4Macro(arg).
В качестве аргумента нужно передать путь к ячейке в закрытой электронной книге:
arg = "'" & path & "[" & file & "]" & Sheet & "'!" & Range(Adress).Range("A1").Address(, , xlR1C1)
Например, в каждом из моих файлов в ячейке D5 содержится имя скважины. Если в тело вышеописанного цикла вставить
Sheet="Лист 1"
Adress = "D5"
For Each file In MySource.Files
FileName = file.Name
WellName = GetValue(FolderName, FileName, Sheet, Adress)
Next file
то в переменную WellName каждый раз будет попадать содержимое ячейки D5. Подставляя в переменную Adress адреса нужных ячеек переносим из нового файла все необходимые данные:
For i = 9 To 17
Adress = "X" & i
ArrNewProbe(t) = GetValue(FolderName, FileName, Sheet, Adress)
t = t + 1
Next i
3) Куда вставлять?
Наша база, как говорилось выше, отсортирована сначала по скважинам, а потом в хронологическом порядке дат отбора проб. Значит, и для ее заполнения нам нужно имя скважины и дата отбора пробы. Оба этих значения есть в массиве ArrNewProbe, так что проблем не возникает. Сначала ищем блок строк для этой скважины
For Each cell In Range("A5:A" & LastRow)
If cell.Formula = WellName Then
If IsEmpty(Range("A" & cell.Row + 1)) And IsEmpty(Range("B" & cell.Row + 1)) And IsEmpty(Range("C" & cell.Row + 1)) Then
NewRow = cell.Row + 1
Exit For
End If
End If
Next
Обратите внимание, здесь для простоты я проверяю совпадение не элемента массива, а простой переменной WellName.
Еще обратите внимание на LastRow. В этой переменной - номер последней строки в данном столбце (ваш капитан очевидность). Определяется он так:
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Фрагмент кода выше делает вот что - проверяет, совпадает ли значение ячейки в столбце А с требуемым именем скважины и, если да, то проверяет пустоту следующей строки. Ведь каждый блок скважин отделен от других как минимум одной пустой строкой - это видно из рисунка в начале статьи.
Найдя такую строку мы понимаем, что можно вставлять данные прямо в нее, но хорошо бы проверить дату, а также хорошо бы создать пустую строку, чтобы и дальше скважины в БД были отделены друг от друга.
Новая строка вставляется очень просто:
Rows(NewRow).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
С датами все тоже не сложно:
For i = NewRow - 1 To 5 Step -1
If CDate(DateWell) >= Range("B" & i).Value And CDate(DateWell) <= Range("B" & i + 1).Value Then
NewRow = i + 1
Exit For
End If
Next i
Здесь проверяется одновременное выполнение двух условий - новая проба должна быть не младше предыдущей и не старше последующей. Это редкий случай, когда проба вносится не в конец БД, но могут прийти и запоздалые результаты анализа.
4) Как вставлять?
У нас все данные в массиве нужной структуры, поэтому мы, не стесняясь, сразу разворачиваем его в нужную строку:
Range("A" & NewRow).Resize(1, Ubound(ArrNewProbe)).Value = WorksheetFunction.Transpose(ArrNewProbe)
На этом все. Задача решена. Можно браться за новую :)
Вопросы? В комментарии!