Модератор: Naeel Maqsudov
то вот один из примеров извлечения данных, где часть пути (название каталога) хранится в ячейке B1 первого рабочего листа текущей рабочей книги. Код: Выделить всё
Private Sub Test()
Dim iPath$, iFormula$
iPath = ThisWorkbook.Worksheets(1).Range("B1")
iFormula = "='W:\Документы\" & iPath & "\[Карточка.xlsx]Карточка'!A1"
With ThisWorkbook.Worksheets(1).Range("A1")
.Formula = iFormula
.Value = .Value
End With
End SubНу, смысл-то да - такой (я только про Unzip xlsx не понял). Вопрос как мышке стать ежиком? И разумеется, что ни одна, а несколько ячеек будут вытягиваться - но для VBA я и сам по аналогии смог бы дополнить, а ести там С++ то конечно не осилю. Если вопрос только в структуре, я готов файлы сбросить, с пояснением разумеется, что в какой папке должно находиться. Вообще там задача конечно сложнее - я просто не хотел перегружать вопрос, расчитывал сам доработать (если на VBA конечно).somewhere писал(а):1. Составляем список найденых файлов вместе с полным путем
2. Unzip xlsx
3. xl\worksheets\sheet1.xml (или другой нужный лист)
4. Смотрим содержимое нужной ячейки
5. Записываем в нужную ячейку каталога
Не знаю насчет макросов на VBA, но на других языках вполне реально. Причем скорость работы будет в десятки раз быстрее, нежели юзать Workbooks(filename).Activate/Open/Close, которые по нескольку секунд один файл открывают и это только ради одной ячейки)
Для отладки все равно нужна конкретная структура
pashulka писал(а):Вообще-то речь шла о том, чтобы выложить только сводный файл, ... , но если Вы не хотите облегчить жизнь людям, которые пытаются Вам помочь
...
End Sub[/code]
Xlsx файл - это упакованая в zip-архив структура XML-файлов. Соответственно, чтобы вытащить данные из конкретного листа файла, нужно распаковать XLSX в память и найти файл, который хранит данные листа (возможно и файл с общими строками). Не смотря на кажущуюся громоздкость, операция очень быстрая и не сравнится с методами VBA, которые запускают отдельный процесс Excel для открытия данных листа.(я только про Unzip xlsx не понял)
somewhere писал(а):Xlsx файл - это упакованая в zip-архив структура XML-файлов. ...
А вообще, я бы подумал организовать такую работу, как сбор данных - средствами хотя бы MS Access. Соответственно вся ваша задача сведется к выполнению одного запроса, который с помощью связи отобразится а в ячейках Excel
. Код: Выделить всё
Private Sub Workbook_Open()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlManual
End With
Dim iCell As Range
With Me.Worksheets(1) 'ThisWorkbook.Worksheets(1)
For Each iCell In .Range(.Cells(1, "B"), .Cells(1, "B").End(xlDown))
With iCell.Offset(, 1)
.Formula = "='W:\Документы\" & iCell.Value & "\[Карточка.xlsx]Карточка'!A1"
.Value = .Value
End With
Next
End With
With Application
.Calculation = xlAutomatic
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Subpashulka писал(а):В цикле это может быть, например, так :
...
pashulka писал(а):В цикле это может быть, например, так :
....
.Код: Выделить всё
'http://allapi.mentalis.org/apilist/SearchTreeForFile.shtml
Private Declare Function SearchTreeForFile _
Lib "imagehlp.dll" ( _
ByVal RootPath As String, _
ByVal InputPathName As String, _
ByVal OutputPathBuffer As String) As Long
Private Sub Test()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlManual
End With
Dim iSource As Range, iCell As Range
Dim iPath$, iFileName1$, iFileName2$, iAddress$, iCount%
iPath = ThisWorkbook.Path 'Можно указать 'родительскую' папку самостоятельно
With ThisWorkbook.Worksheets(1)
Set iSource = .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp))
'Set iSource = .[A:A].SpecialCells(xlConstants, xlNumbers)
End With
For Each iCell In iSource
iFileName1 = iCell & ".xlsx": iFileName2 = Space(255)
If SearchTreeForFile(iPath, iFileName1, iFileName2) <> 0 Then
iFileName2 = Application.Trim(iFileName2)
iFileName2 = Replace(iFileName2, iFileName1, "[" & iFileName1 & "]", , , vbTextCompare)
For iCount = 1 To 3
iAddress = Choose(iCount, "F54", "H83", "A5")
With iCell.Offset(, iCount)
.Formula = "='" & iFileName2 & "Лист1'!" & iAddress
.Value = .Value
'Возможно имеет смысл заменять формулы на значения, либо
'сразу в трёх ячейках строки, либо вообще во 'всём' диапазоне
End With
Next
Else
iCell.Offset(, 1).Resize(, 3) = CVErr(xlErrNA) '#Н/Д
End If
Next
With Application
.Calculation = xlAutomatic
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub