Написал по просьбе одной милой девушки... )
Итак, программа. Очень простая, не требует никаких особых знаний, но имеет свои ограничения. Ограничения связаны с тем, что ячейки Екселя не обладают жестко заданной структурой, и сделаны следующие допущения:
1) На компе все таки есть Office и Excel...
2) информация извлекается из товарной накладной - это лист "тн " (именно так, с пробелом) в любой найденной книге XLS. Если в книге такого листа нет, то книга пропускается - в общем списке будет предупреждение.
3) информация о товаре находится на три строки ниже слова "товар", расположенного во 2-м столбце, ищется с 15 по 35 строку. Поиск строк с товаром кончается если при переборе строк следующая оказывается пустой. Если же слово "товар" вообще не найдено, то книга тоже пропускается - делается предупреждение.
4) Номер документа находится обязательно в девятом столбце на две ячейки ниже надписи "номер документа", которая находится пределах от 10-й до 30-й строки, т.е. ее расположение по вертикали может "плавать" и программа будет искать ее в этих пределах.
5) Плательщик находится в третьем столбце, на двух строках, и он ищется по слову "Плательщик" в первом или втором столбце, само слово ищется от 5 до 25 строки
6) дата составления находится в десятом столбце, ищется по фразе "Дата составления", плавает от 10 до 30 строки
7) суммарное количество всех строк с товаром не может превышать 10000 - можно поставить и 65 тысяч, это максимум для экселя, но время работы вырастет в разы - объем пустого пространства тоже перемалывается и на это тратится время.Работа:
1) при запуске программы она спрашивает, в какой файл сохранять данные. Указываем, при необходимости перезаписи существующего файла подтверждаем это
2) указываем директорию, в которой лежат наши рабочие файлы. Там должны лежать ТОЛЬКО файлы, соответствующие вышеприведенным условиям, иначе программа вылетит. Как лежат файлы, в каких подпапках - не важно, она их всех найдет и извлечет данные.
3) получаем сообщение что все ок и все - можно открывать файл с результатом.
4) Раздвиньте колонки по вкусу, выделите все семь (выделив заголовки, если кто не в курсе) и нажмите Данные-Фильтр-Автофильтр - получите простейшую базу данных с фильтрованием по любому параметру или их сочетанию.
#include <Array.au3>
MsgBox (0, "Предупреждение", "Рекомендую перед работой ознакомиться с инструкцией Excel.txt, ибо программа имеет ограничения, связанные с человеческим фактором")
$oExcel = ObjGet("", "Excel.Application") ; "схватить" существующий объект Excel (например, файл уже открыт в Excel)
If @error Then ; в случае неудачи создаем новый объект Excel и открываем требуемый файл
$oExcel = ObjCreate("Excel.Application") ; создать объект Excel
If Not IsObj($oExcel) Then Exit ; выйти, если не удалось создать объект Excel
EndIf
$sFilePath = FileSaveDialog ( "Указать путь к файлу результата", "", "Книга Excel (*.xls)", 1)
$oExcel.Workbooks.Add
$oExcel.ActiveWorkBook.SaveAs ($sFilePath)
$oExcel.ActiveWorkBook.ActiveSheet.Name = "Таблица товаров"
$DirsArray = DirListToArray(StringRegExpReplace(FileSelectFolder( "Папка", "")& "\", '\\[^\\]+$', ''))
;_ArrayDisplay($DirsArray)
$FilesArray = FilesListToArray($DirsArray)
;_ArrayDisplay($FilesArray)
$StrArray = DataToList($FilesArray)
;_ArrayDisplay($StrArray)
$oExcel.Workbooks(RetFileName($sFilePath)).Worksheets("Таблица товаров").Cells(1, 1) = "Товар"
$oExcel.Workbooks(RetFileName($sFilePath)).Worksheets("Таблица товаров").Cells(1, 2) = "Кол-во"
$oExcel.Workbooks(RetFileName($sFilePath)).Worksheets("Таблица товаров").Cells(1, 3) = "Ед.изм"
$oExcel.Workbooks(RetFileName($sFilePath)).Worksheets("Таблица товаров").Cells(1, 4) = "Дата отправления"
$oExcel.Workbooks(RetFileName($sFilePath)).Worksheets("Таблица товаров").Cells(1, 5) = "Накладная"
$oExcel.Workbooks(RetFileName($sFilePath)).Worksheets("Таблица товаров").Cells(1, 6) = "Покупатель"
$oExcel.Workbooks(RetFileName($sFilePath)).Worksheets("Таблица товаров").Cells(1, 7) = "Цена"
$oExcel.Workbooks(RetFileName($sFilePath)).Worksheets("Таблица товаров").Rows(1).Font.Bold = True
for $i = 1 to $StrArray[0][0]
for $j = 0 to 6
$oExcel.Workbooks(RetFileName($sFilePath)).Worksheets("Таблица товаров").Cells($i+1, $j+1) = $StrArray[$i][$j]
Next
Next
$oExcel.DisplayAlerts = 0 ; отключить предупреждения
$oExcel.Save ; сохранить файл
$oExcel.Quit ; выйти из экселя
MsgBox (0, "Поздравляю", "Файл результата готов")
Func DirListToArray($sPath, $sRootPath=1)
$sPath = StringRegExpReplace($sPath, '\\+$', '')
Local $aRetArray[1], $aSubDirsArr, $sFindNextFile, $sCurrentPath
Local $sFindFirstFile = FileFindFirstFile($sPath & "\*.*")
If @error = 1 Then Return SetError(1, 0, -1)
If $sRootPath = 1 Then
ReDim $aRetArray[2]
$aRetArray[1] = $sPath
$aRetArray[0] += 1
EndIf
While 1
$sFindNextFile = FileFindNextFile($sFindFirstFile)
If @error = 1 Then ExitLoop
$sCurrentPath = $sPath & "\" & $sFindNextFile
If StringInStr(FileGetAttrib($sCurrentPath), "D") Then
$aRetArray[0] += 1
ReDim $aRetArray[$aRetArray[0]+1]
$aRetArray[$aRetArray[0]] = $sCurrentPath
$aSubDirsArr = DirListToArray($sCurrentPath, 0)
If IsArray($aSubDirsArr) Then
For $i = 1 To $aSubDirsArr[0]
$aRetArray[0] += 1
ReDim $aRetArray[$aRetArray[0]+1]
$aRetArray[$aRetArray[0]] = $aSubDirsArr[$i]
Next
EndIf
EndIf
WEnd
FileClose($sFindFirstFile)
Return $aRetArray
EndFunc
Func FilesListToArray($sPath, $Ext="xls")
$j = $sPath[0]
for $i = 1 to $j
Local $sFindFirstFile = FileFindFirstFile($sPath[$i] & "\*." & $Ext)
If @error = 1 Then Return SetError(1, 0, -1)
; _ArrayAdd ( $sPath, $sPath[$i] & "\" & $sFindFirstFile )
While 1
$sFindNextFile = FileFindNextFile($sFindFirstFile)
If @error = 1 Then ExitLoop
_ArrayAdd ( $sPath, $sPath[$i] & "\" & $sFindNextFile)
$sPath[0] += 1
WEnd
Next
for $i = 1 to $j
_ArrayDelete ( $sPath, 1)
$sPath[0] -= 1
Next
Return $sPath
EndFunc
Func DataToList ($sPath)
Dim $Excels[10000][7]
$i = 0
Do
$ii=$i + 1
$oExcel.Workbooks.Open ($sPath[$ii]) ; открыть в Excel указанный файл
if FindSht(RetFileName($sPath[$ii]), "тн ") = True Then
$str = FindStr(RetFileName($sPath[$ii]), 'Товар', 15, 2)
if $str > 0 then
$dates = $oExcel.Workbooks(RetFileName($sPath[$ii])).Worksheets("тн ").Cells(FindStr(RetFileName($sPath[$ii]), 'Дата составления', 10, 10)+2, 10).Value
$num = $oExcel.Workbooks(RetFileName($sPath[$ii])).Worksheets("тн ").Cells(FindStr(RetFileName($sPath[$ii]), 'Номер документа', 10, 9)+2, 9).Value
$n = FindStr(RetFileName($sPath[$ii]), 'Плательщик:', 5, 1) + FindStr(RetFileName($sPath[$ii]), 'Плательщик:', 5, 2)
$pl = $oExcel.Workbooks(RetFileName($sPath[$ii])).Worksheets("тн ").Cells($n, 3).Value & ' ' & $oExcel.Workbooks(RetFileName($sPath[$ii])).Worksheets("тн ").Cells($n + 1, 3).Value
$j = 4
While $oExcel.Workbooks(RetFileName($sPath[$ii])).Worksheets("тн ").Cells($str + $j, 2).Value > ""
$Excels[0][0] += 1
$Excels[$Excels[0][0]][0] = $oExcel.Workbooks(RetFileName($sPath[$ii])).Worksheets("тн ").Cells($str + $j, 2).Value
$Excels[$Excels[0][0]][1] = $oExcel.Workbooks(RetFileName($sPath[$ii])).Worksheets("тн ").Cells($str + $j, 10).Value
$Excels[$Excels[0][0]][2] = $oExcel.Workbooks(RetFileName($sPath[$ii])).Worksheets("тн ").Cells($str + $j, 4).Value
$Excels[$Excels[0][0]][6] = $oExcel.Workbooks(RetFileName($sPath[$ii])).Worksheets("тн ").Cells($str + $j, 11).Value
$Excels[$Excels[0][0]][3] = StringMid( $dates, 7, 2) & '.' & StringMid( $dates, 5, 2) & '.' & StringMid( $dates, 1, 4)
$Excels[$Excels[0][0]][4] = $num
$Excels[$Excels[0][0]][5] = $pl
$j += 1
WEnd
Else
$Excels[0][0] += 1
$Excels[$Excels[0][0]][0] = "Книга " & $sPath[$ii] & " пропущена - не найдены данные"
EndIf
Else
$Excels[0][0] += 1
$Excels[$Excels[0][0]][0] = "Книга " & $sPath[$ii] & " пропущена - не найден лист с данными"
EndIf
$oExcel.DisplayAlerts = 0 ; отключить предупреждения
$oExcel.Save ; сохранить файл
$oExcel.workbooks(RetFileName($sPath[$ii])).Close(0); // xlDontSaveChanges
$i += 1
Until $i = $sPath[0]
Return $Excels
EndFunc
Func RetFileName ($var)
$var2 = StringLen ($var)
if StringLen ($var) > 0 then Return StringRight( $Var, $var2 - StringInStr( $var, "\", 0, -1 ))
EndFunc
Func RetDirName ($var)
if StringLen ($var) > 0 then Return StringLeft( $Var, StringInStr( $var, "\", 0, -1 ))
EndFunc
Func FindStr ($sFile, $str, $x, $y)
for $i = $x to $x + 20
if StringInStr( $oExcel.Workbooks($sFile).Worksheets("тн ").Cells($i, $y).Value, $str) > 0 then Return $i
Next
EndFunc
Func FindSht ($sFile, $str)
$x = False
$y = $oExcel.Workbooks($sFile).Sheets.Count
for $i = 1 to $y
if $oExcel.Workbooks($sFile).Worksheets($i).Name = $str then $x = True
Next
Return $x
EndFunc