{quote}{login=metrox}{date=09.12.2012 05:17}{thema=VBA - VLOOKUP с обращением к другой книге}{post}Имеется база в 1 файле, рабочая книга в другом. <...> Где-то видел пример, как сделано то же самое простым перебором (<STRONG>без обращения к другому файлу</STRONG>){/post}{/quote}Перечитайте своё сообщение :-)

Если вставить:  
Dim wkbk As Workbook  
Set wkbk = Workbooks.Open("C:\excel\DATABASE.xls")  
То работает, но с открытием файла. Надо бы сделать без - это возможно?  
 
П.С. А вообще вопрос, я тут надоел своими непонятными никому вопросами?  
Вы скажите, не буду надоедать, так сказать =)

Где я написал такую околесицу?

Ладно, тема закрыта.  
Разберусь ;)  
 
P.S. Перефразирую:  
Где-то видел пример, как сделано то же самое простым перебором (но там нет возможности обращаться к другому файлу).

Да, если это нужно сделать средствами VBA - то ответ на поверхности: пишем кодом в ячейку формулу, затем меняем её на полученный ею результат :)

Не понимаю, почему нельзя использовать VLOOKUP() листа?  
Ну а если делать как у Вас - то можно сразу функцией VBA возвращать массив значений, которые затем перемножать.  
Прописывать в коде не буду - поздно уже. Да и исходные условия нам не известны - например количество параметров постоянно или может меняться?  
И в таком виде у Вас double только Cw, посмотрите в  Locals:  
Dim H, b, Tw, Tf, R1, Cf, Cw As Double

Доброе утро.  
Да, тип нужно указывать для каждой переменной. У Вас все остальные variant - это видно в Locals.  
По задаче - можно ведь сразу взять всю найденную строку (или нужную её часть) в массив, и затем уже его перебирать.  
Так будет всего один поиск, а не на каждый элемент.  
Ещё такой вариант - при открытии файла заполняем публичный словарь значениями, которые собираемся искать, каждому в item номер строки. Затем уже в процессе работы сразу по номеру строки из словаря берём данные, без поиска по листу.  
Если нужно обновить словарь - можно вывести кнопку запуска макроса на лист.  
Хотя на Ваши объёмы это роли не играет, разницы не заметите.  
С кодом сейчас не помогу - понедельник день тяжёлый, за выходные много работы навалило, нужно разгребать...

Зачем 2 функции?  
Проще ведь всё делать в одной.  
На лист в ячейку (это если из закрытого файла тянем):  
=ECH(H15,'C:\Temp\[post_384074.xls]Sheet2'!$A$1:$BE$7,3,4,5,6,7)
 
 
Ну а код такой:  
Function ECH(Profile As String, table As Variant, ParamArray NeedColls())  
   Dim i&, el  
   If TypeName(table) = "Range" Then table = Intersect(table.Parent.UsedRange, table).Value  
   For i = 1 To UBound(table)  
       If table(i, 1) = Profile Then  
       ECH = 1  
           For Each el In NeedColls: ECH = ECH * table(i, el): Next  
           Exit For  
       End If  
   Next  
End Function  
 
Intersect для того, чтоб меньше просматривать, если указаны столбцы целиком (в этой книге!).  
При работе с закрытой книгой обязательно указывать конкретный диапазон, "целиком столбцы" не работает!

Hugo, спасибо за ответ.  
Но наверное я не так объяснил опять, не знаю.  
Расскажу что у меня имеется сейчас.  
Имеется таблица, такого же типа как и в примере. Функциями эксель (Через Vlookup) сделал выбор необходимых данных каждого столабца, в частности выбор необходимой строки. Предположим из примера для IPE 80.  
Потом ссылаясь на этот регион в VBA назначаю для каждого столбца строки переменную, пример:  
incells = Data.Value  
H = incells(1, 1)  
b = incells(1, 2)  
Где H, b и т.д. столбик определенной строки для IPE 80.  
Хотелось сделать назначение переменных H,B и т.д. на прямую без необходимости делать отделный выбор нужной строки.  
Для этого написал функцию:  
Function VLOOKUPMY(Value As String, ResultColumn As Integer)  
Dim i%  
Dim table As range  
Dim column As Integer  
Set table = Worksheets("Profiles").range("C8:BU2000")  
column = "1"  
   For i = 1 To table.Rows.Count  
       If table.Cells(i, column) = Value Then  
               VLOOKUPMY = table.Cells(i, ResultColumn)  
           Exit For  
       End If  
   Next i  
End Function  
 
И думал назначать таким образом:  
H = VLOOKUPMY(Profile, 3)  
b = VLOOKUPMY(Profile, 4)  
 
Но как писал выше - это не рационально т.к. производится поиск для каждой переменной каждый раз.  
Надеюсь понятна моя задача.

Ув. Hugo, да, необходима потом эта куча переменных. Они используются для дальнейших расчетов всей программы.  
Спасибо

Спасибо что помогаете =)  
Я думал использовать UDF для задания переменных.Мне не обязательна именно UDF, можно и через sub, но главное задать переменные.Не надо даже это все выводить на рабочий лист.  
 
Может так будет проще:  
Предположим надо сделать то же самое, но через sub.  
Переменные:  
Profile="IPE 100", set table=Range("A1:BE7"), как ParamArray задать не знаю.  
 
В виде результата просто вывести сообщение на экран со значениями искомой строки для столбцов B=....,C=....,D=.... и т.д. (конечно не надо делать для всех).  
Если бы это было бы, то я на основе этого смог бы задать для каждого значения свою переменную и использовать их в дальнейших расчетах программы.  
Задача понятна в такой формулировке ?

Эти данные можно просто брать из ячейки.  
Предположим:  
A23 = IPE 100 - этот параметр меняется.  
A24 = A1:BE7 - этот параметр постоянен, его по идеи можно прописать прямо в sub.  
ParamArray - тоже параметр постоянен, количество столбцов не меняется. (В оригинале их 50)

Hugo, спасибо, то что надо =)))  
ПРо другую книгу я уже как-то перестал и надеиться :D  
Набросал как сам вижу, но не работает что-то:  
 
Option Explicit  
Dim workarr  
 
Sub test()  
Dim wkbk As Workbook  
Dim a(), NeedColls, Profile$, i&, ii&, el  
 
Application.ScreenUpdating = False  
Set wkbk = Workbooks.Open("C:\excel\DATABASE.xls")  
Set a = wkbk.Worksheets("DATABASE").Range("A2:BE7")  
 
Profile = "IPE 100"  
NeedColls = Array(4, 5, 6, 7, 9)  
 
For i = 1 To UBound(a)  
If a(i, 1) = Profile Then  
ReDim workarr(1 To 1, 1 To UBound(NeedColls) + 1)  
For Each el In NeedColls  
ii = ii + 1  
workarr(1, ii) = a(i, el)  
Next  
Exit For  
wkbk.Close False  
End If  
Next  
ActiveWindow.DisplayZeros = False  
''[a20].Resize(1, UBound(workarr, 2)) = workarr
MsgBox workarr(1, 1)  
End Sub

Почти, совсем немного ошиблись:  
 
Sub test()  
 
   Dim a(), NeedColls, Profile$, i&, ii&, el  
 
   Application.ScreenUpdating = False  
   With Workbooks.Open("c:\Temp\metrox\DATABASE.xls")  
       a = .Worksheets("Sheet2").Range("A2:BE7").Value  
       .Close 0  
   End With  
 
   Profile = "IPE 100"  
   NeedColls = Array(4, 5, 6, 7, 9)  
 
   For i = 1 To UBound(a)  
       If a(i, 1) = Profile Then  
           ReDim workarr(1 To 1, 1 To UBound(NeedColls) + 1)  
           For Each el In NeedColls  
               ii = ii + 1  
               workarr(1, ii) = a(i, el)  
           Next  
           Exit For  
       End If  
   Next  
   ActiveWindow.DisplayZeros = False  
 
   ''[a20].Resize(1, UBound(workarr, 2)) = workarr
   MsgBox workarr(1, 1)  
 
End Sub