Перенос данных из закрытой книги по условию

[strannick]

Добрый день, уважаемые формучане!
Дело в принципе простое, даже макрорекодером записывал макрос, но с открытием книги. Начал переделывать и запутался. А задача такая. Есть книга Акции и книга Откуда (во вложении). Собственно надо из, желательно закрытой (но не догма), книги Откуда, проверив столбец В, найти в ячейке слово Акции, вытащить значение из столбца I этой же строки и вставить в следующую свободную ячейку столбца В книги Акции.
Понимаю, что мешает какая-то мелочь, но что именно - не вижу:

For j = 12 To 55
If Cells(j, 2) = "Акции" Then Cells(iLastRow + 1, 2) = Cells(i, 9)

P.S. Заранее спасибо! И, похоже, пора в отпуск.

[doober]

Public Function ADO_R_Dmitry(ByVal strSql$, ByVal FilePath$, ByVal OutputRange As Range, _
ByVal FieldsName As Boolean, ByVal OutputFieldsName As Boolean)
'==============================================================================
'*Описание функции : Возвращает набор записей Recordset с первой ячейки адреса,
'* указанного диапазона.
'*strSql - Конструкция SQL  запроса.
'* FilePath - Полный путь к файлу включая имя и расширение.
'* OutputRange - адрес ячеки с которой начинается вывод данных.
'* FieldsName - используются или нет заголовки столбцов (True - False)
'* OutputFieldsName - вывод данных с заголовками или без (True - False), _
'* если FieldsName=False, заголовки не выводятся.
'==============================================================================
'* Автор R Dmitry (Дмитрий Русак dg_rusak@mail.ru skype: RDG_Dmitry)          |
'* WM:_R269866874234 U144446690328                                            |
'==============================================================================
Dim sCon As String, FieldName As String
Dim rs As Object, cn  As Object
Set rs = CreateObject("ADODB.Recordset")
Set cn = CreateObject("ADODB.Connection")
If FieldsName Then FieldName = "Yes" Else FieldName = "No"
Select Case CLng(Split(Application.Version, ".")(0))
    Case Is < 12
        sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FilePath _
          & ";Extended Properties=""Excel 8.0;HDR=" & FieldName & ";IMEX=1"";"
    Case Is >= 12
        sCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FilePath _
        & ";Extended Properties=""Excel 12.0;HDR=" & FieldName & ";IMEX=1"";"
End Select

cn.Open sCon
If Not cn.State = 1 Then Exit Function
Set rs = cn.Execute(strSql)
If Not FieldsName Then OutputFieldsName = False
 If OutputFieldsName Then
    For i = 0 To rs.Fields.Count - 1
    OutputRange.Offset(0, i) = rs.Fields(i).Name
    Next
    Set OutputRange = OutputRange.Offset(1, 0)
 End If
OutputRange.CopyFromRecordset rs
rs.Close:  cn.Close
Set cn = Nothing: Set rs = Nothing
End Function



Sub Go_Акция()
 M_name$ = "TDSheet$A1:I100"

 Sql_S = "SELECT F9 FROM [" & M_name$ & "]  WHERE F2 Like 'Акции'"

ADO_R_Dmitry Sql_S, "C:\Documents and Settings\Сергей\Рабочий стол\ППП\откуда.xlsx", Лист1.Cells(1, 1), False, False

End Sub

[strannick]

Ого!!!!!! Ну, это вааще........ Для извлечения данных из закрытой книги пользовался вот этим кодом:

Sub Get_Value_From_Close_Book_Excel4Mac ro()
Dim sPath As String, sFile As String, sShName As String
Dim sAddress As String, vData
sPath = "C:\Documents and Settings\"
sFile = "Книга1.xls"
sShName = "Лист1"

sAddress = "'" & sPath & "[" & sFile & "]" & sShName & "'!" & Range("A1").Address(ReferenceStyle: =xlR1C1)
vData = ExecuteExcel4Macro(sAddress)
End Sub

Но, это когда известно в какой ячейке лежит нужное. А тут с проверкой. Потому и попытался сделать с открытием книги и тем кусочком кода, который привел выше. Не пролезло. Причем, сначала вроде бы работало, а потом перестало.

[staniiislav]

смотрите пример:
взят:
http://programmersforum.ru/showthread.php?t=89472

[strannick]

Все нормально, работает. Спасибо огромное!

[Hugo121]

Думаю, можно было макросом записать в ячейку ВПР()/VLOOKUP(), затем заменить на полученное значение (файлы не смотрел, сужу по описанию задачи).

[staniiislav]

Сообщение от Hugo121

Думаю, можно было макросом записать в ячейку ВПР()/VLOOKUP(), затем заменить на полученное значение (файлы не смотрел, сужу по описанию задачи).

А как быть если есть повторяющиеся значени? Можно как-то ВПР заставить следующее одинаковое значение найти?

[Hugo121]

Про повторяющиеся речь не шла

[staniiislav]

Сообщение от Hugo121

Про повторяющиеся речь не шла

Вы правы

[strannick]

Можно было бы и ВПР, а при повторяющемся ВПР2, но его там нет, только одно. Так что спасибо, использовал макрос, предложенный doober. Столкнулся с такой небольшой проблемкой. Этот макрос запускается в общем пакете с другими после проверки текущего дня недели. Так вот, почему-то, в общем пакете на 2007-м срабатывает, а на 2010-м не срабатывает. А при самостоятельном запуске и на 20010-м срабатывает. Что это может быть?