Excel: Вызов функций Application из тела функции

@marqueemarmot · Регистрация: 08.05.2014

Author24 — интернет-сервис помощи студентам

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

Visual Basic

Sub mopen()
Dim pfilename As String
pfilename = ThisWorkbook.Path & "\PVTprop.xlsx"
 
Workbooks.Open filename:=pfilename
End Sub

работает.
Мне нужно, чтобы сие действие выполнялось внутри функции (она производит расчет, и ей нужны данные из того второго файла-справочника). Запихиваю тот же код в функцию.

Visual Basic

Public Function popen() As Boolean
 
Dim pfilename As String
pfilename = ThisWorkbook.Path & "\PVTprop.xlsx"
Workbooks.Open filename:=pfilename
 
End Function

Результата нет. то есть функция ошибки не выдает, но открытия файла не происходит.
Работаю в экселе 2013, опыт показал, что в 2003 то же самое, попытка даже просто создать книгу, или закрыть эксель ни к чему не приводит. В Sub - все работает. Гуглила на тему функций и процедур - не нашла упоминаний, что нельзя так делать. Объясните в чем дело?
Для себя пока что написала макрос, что копирует справочник в текущую книгу, и брать значения буду из него, возможно, что так даже лучше, но вопрос остался открытым.

@Казанский · 08.05.2014, 10:20

marqueemarmot, функция "не имеет права" менять что-либо в объектах Excel, в т.ч. открывать/закрывать книги, создавать/удалять листы, даже форматировать ячейки.
Однако, можно открыть как COM-объект:

Visual Basic

Public Function popen() ' As Boolean
 
Dim pfilename As String
pfilename = ThisWorkbook.Path & "\PVTprop.xlsx"
With GetObject(pfilename)
  popen = .Worksheets(1).Range("A1")
End With
 
End Function

@marqueemarmot · 08.05.2014, 10:25 **[ТС]**

Казанский, спасибо.
думала об этом, но не нашла информации... (а есть линк, где это написано, мсдн, или хотя б книжка какая?)
Вообще-то не очень логично, конечно...
как раз думала о том, чтобы другая функция в зависимости от некоторых результатов внутри себя (не возвращаемого значения) окрашивала ячейку, в которой я ее вызываю, или хотя бы хинт делала.. это реально как-то сделать?

@Казанский · 08.05.2014, 10:50

marqueemarmot, почитайте Вытянуть данные из закрытых книг в Excel
Красить ячейку можно условным форматированием.

@marqueemarmot · 08.05.2014, 10:58 **[ТС]**

не выйдет, поскольку окрашивать хочу не по результатам, возвращаемым функцией. Объясняю. Логика такая, считаем некое A=F(x,y). При этом есть некая функция B(x,y), которая определяет насколько достоверно пользоваться функцией A=F(x,y). Вот и хотелось бы, когда достоверность низкая, чтобы он окрашивал результат. Можно конечно в соседнем столбце отдельно определять достоверность и в соответствии с ней окрашивать, но это очень неудобно, потому, что даже А - это лишь промежуточные вычисления, и загромождать лист не хочется. Опять же возможно, я и приду к тому, что все расчеты делать на другом листе, копируя туда инфу, и хранить там все промежуточные расчеты, а на исходный лист выводить уже только нужну информацию... но это крайне неудобно

@Казанский · 08.05.2014, 13:16

marqueemarmot, пользовательскую функцию можно использовать в условном форматировании.
И почему бы все расчеты не делать в VBA, а на лист только результаты выводить?

@marqueemarmot · 09.05.2014, 12:45 **[ТС]**

ну, многое проще уже встроенными функциями Экселя, скажем линейную и квадратичную аппроксимацию. А так вобщем-то на лист и вывожу только то, что нужно. Просто работа исследовательская и часть "условно промежуточных" данных важна для анализа.

пользовательскую функцию можно использовать в условном форматировании

ок, спасибо, попробую

@Казанский · 09.05.2014, 13:03

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

многое проще уже встроенными функциями Экселя, скажем линейную и квадратичную аппроксимацию

Встроенные функции можно и нужно использовать в VBA!
Причем это можно делать двумя способами: функция как метод объекта Application (или объекта Application.Worksheetfuncion), или вызывая интерпретатор формул Evaluate.
В этой теме используются оба способа, и даже еще один - [A1:K50] это неявный вызов evaluate("A1:K50"):
Удалить 20% максимальных чисел в столбце Excel 2007

@marqueemarmot · 12.05.2014, 10:08 **[ТС]**

Опять проблема - есть функция:

Visual Basic

Function getProp(ByVal pname As String, _
                 Optional ByRef pMm As Double = 1, _
                 Optional ByRef pTb As Double = 1, _
                 Optional ByRef pTc As Double = 1, _
                 Optional ByRef pPc As Double = 1, _
                 Optional ByRef pVc As Double = 1, _
                 Optional ByRef pOm As Double = 1) As Boolean
 
getProp = False
Dim Ash As Worksheet 
Set Ash = Sheets(PropGasSheetName)
Ash.Activate
Dim f As Range, all As Range
Set all = Range("A1:A100")
Set f = all.Find(pname, , xlValues, xlWhole)
If f Is Nothing Then
    Set all = Range("B1:B100")
    Set f = all.Find(pname, , xlValues, xlWhole)
    If f Is Nothing Then Exit Function
End If
 
pMm = Cells(f.Row, 3)
pTb = Cells(f.Row, 4)
pTc = Cells(f.Row, 5)
pPc = Cells(f.Row, 6)
pVc = Cells(f.Row, 7)
pOm = Cells(f.Row, 8)
 
getProp = True
End Function[/BASIC]
Если проверять сабом - работает:
[BASIC]Sub trygetprop() 
Dim Mm As Double
Dim b As Double, c As Double, d As Double, e As Double, f As Double
Dim res As Boolean
res = getProp(pname:="H2", pMm:=Mm)
 
MsgBox (Mm)
 
 
End Sub

если функцией - нет, проверяю - не активирует нужный лист при вызове из функции.

Visual Basic

Function trygetprop() As Double
Dim Mm As Double
Dim b As Double, c As Double, d As Double, e As Double, f As Double
Dim res As Boolean
res = getProp(pname:="H2", pMm:=Mm)
 
MsgBox (Mm)
trygetprop = Mm
 
End Function

Как обойти? Как брать нужное значение, с тем, что мне его искать на листе нужно?

Добавлено через 2 минуты
П.С. не по теме, а можно как-то пообщаться по аське, или в скайпе/вк?

@Казанский · 12.05.2014, 10:34

marqueemarmot, чтобы работать с листом, вовсе не нужно его активировать (функции это тоже "запрещено").

Visual Basic

Function getProp(ByVal pname As String, _
                 Optional ByRef pMm As Double = 1, _
                 Optional ByRef pTb As Double = 1, _
                 Optional ByRef pTc As Double = 1, _
                 Optional ByRef pPc As Double = 1, _
                 Optional ByRef pVc As Double = 1, _
                 Optional ByRef pOm As Double = 1) As Boolean
 
Dim f As Range, all As Range
'getProp = False
With Sheets(PropGasSheetName)
  Set all = .Range("A1:A100")
  Set f = all.Find(pname, , xlValues, xlWhole)
  If f Is Nothing Then
      Set all = .Range("B1:B100")
      Set f = all.Find(pname, , xlValues, xlWhole)
      If f Is Nothing Then Exit Function
  End If
   
  pMm = .Cells(f.Row, 3)
  pTb = .Cells(f.Row, 4)
  pTc = .Cells(f.Row, 5)
  pPc = .Cells(f.Row, 6)
  pVc = .Cells(f.Row, 7)
  pOm = .Cells(f.Row, 8)
End With
getProp = True
End Function

Добавлено через 9 минут
В Excel2000 еще метод Range.Find в функции не работал, в 2003 уже работал. Хотя вместо него вполне можно использовать ПОИСКПОЗ.
Так немного быстрее будет - меньше обращений к ячейкам:

Visual Basic

Function getProp(ByVal pname As String, _
                 Optional ByRef pMm As Double = 1, _
                 Optional ByRef pTb As Double = 1, _
                 Optional ByRef pTc As Double = 1, _
                 Optional ByRef pPc As Double = 1, _
                 Optional ByRef pVc As Double = 1, _
                 Optional ByRef pOm As Double = 1) As Boolean
 
Dim f As Range, all As Range, v()
'getProp = False
With Sheets(PropGasSheetName)
  Set all = .Range("A1:A100")
  Set f = all.Find(pname, , xlValues, xlWhole)
  If f Is Nothing Then
      Set all = .Range("B1:B100")
      Set f = all.Find(pname, , xlValues, xlWhole)
      If f Is Nothing Then Exit Function
  End If
  v = .Cells(f.Row, 3).Resize(, 6).Value
End With
pMm = v(1, 1)
pTb = v(1, 2)
pTc = v(1, 3)
pPc = v(1, 4)
pVc = v(1, 5)
pOm = v(1, 6)
getProp = True
End Function

@marqueemarmot · 12.05.2014, 11:11 **[ТС]**

почти дошла до этого

VBA всегда присваивает новой переменной значение 0/Flalse? я смотрю, комментировано первое присваивание

@marqueemarmot · 12.05.2014, 14:02 **[ТС]**

По поводу идеи про условное форматирование. Описала функцию:

Visual Basic

Function DensCritCmp(ByVal P As Double, _
                     ByVal T As Double, _
                     ByVal name As String) As Double
Dim res As Boolean, Vc As Double, z As Double, ro As Double, v As Double
 
res = getProp(pname:=name, pVc:=Vc)
z = zRKA(P, T, name)
v = z / (P) * 82.04 * T
DensCritCmp = Vc / v
End Function

Функция, рабочая, все ок, но...
Имею такие вычисления - во вложении.
Задача - подсвечивать значение, вычисляемое zrkA, если значение DensCritCmp от тех же параметров больше 0.5.
Попробовала вставить в условное форматирование как формулу, переправил мне формулу (ссылки в ней) на не пойми куда: было RC[-4] стало RC[16380]

@Казанский · 12.05.2014, 14:40

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

VBA всегда присваивает новой переменной значение 0/Flalse?

Да.

Сообщение от F1 - Dim Statement

When variables are initialized, a numeric variable is initialized to 0, a variable-length string is initialized to a zero-length string (""), and a fixed-length string is filled with zeros. Variant variables are initialized to Empty. Each element of a user-defined type variable is initialized as if it were a separate variable.

Идентификатор функции внутри функции - та же самая переменная.

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

Попробовала вставить в условное форматирование как формулу, переправил мне формулу (ссылки в ней) на не пойми куда: было RC[-4] стало RC[16380]

Наверно, ко всей строке УФ применили. В этом случае Excel меняет ссылки как для первой (или последней?) ячейки строки и закольцовывает диапазон, т.е. вместо 0 столбца становится 16384, вместо -1 столбца 16383 и т.д.
Попробуйте назначить УФ для ограниченного диапазона ячеек так, чтобы ссылки не уходили за край листа.

@marqueemarmot · 13.05.2014, 09:03 **[ТС]**

И еще, в продолжение той же темы. Есть макрос, который обсчитывает данные текущего листа, в итоге я его зацикливаю по всем листам книги (около 300). Он использует встроенный экселевский расчет аппроксимаций, в данном случае линейный (условно, потому как подразумевается степенная зависимость, перевожу ее к линейному виду через логарифмирование) и обрабатываю. Мне нужно еще добавить квадратичное, что не бог весть какая задача, Вопрос в другом. Может быть есть предложения, как переписать более эффективно данный код...
Алгоритмически я прологарифмированные данные переношу вниз листа, там обрабатываю ИНДЕКС и ЛИНЕЙН, отбрасываю выпадающие точки и снова рассчитываю коэффициенты аппроксимации. При этом приходится сохранять полученные значения на листе. Вопрос больше именно про эффективность, быть может, можно обойтись без копирования диапазона ячеек вниз листа для расчета,а создания некоего диапазона/массива данных, с которым уже работать. Если есть идеи, буду благодарна.

Не по теме:

Надеюсь не достала :) Знаю, много вопросов, в том числе и дурацких, но совсем никого нет рядом знающего, гугл тонкостей сходу не дает, при этом нет времени циклиться на полноценном решении проблем, приходится затыкать дыры и идти дальше, что потом сильно мешает

Добавлено через 13 часов 5 минут
собственнокод

Visual Basic

 Sub Tdep1stR(Asheet As Worksheet)
    '----->>> Процедура обсчета текущего листа на температурную зависимость при 0,1 МПа:
    'запускается обычно в цикле на всю книгу - первичная обработка зависимости
    
    Dim myrng As Range, cell As Range ' не забываем объявлять переменные!!!
    ' myRng - диапазон поиска: строки со 2 по 300 например (значит не более 300 точек в системе).
    ' cell - текущая ячейка
 
 
    Set myrng = Asheet.Range(Cells(2, 1), Cells(NumPts, 5)) ' Объявляем диапазон поиска
    Set cell = myrng.Find("замеч", , , xlPart) ' Находим конец таблицы значений по ключевому слову
    Dim Nrow 'переменная для номера строки конца диапазона
    Nrow = cell.Row - 1
 
    Set myrng = Range(Cells(2, 1), Cells(Nrow, 5)) 'задаем диапазон для сортировки
    myrng.Select
 
    'Очистка параметров сортировки
    Asheet.Sort.SortFields.Clear
    'Задание параметров сортировки
    Asheet.Sort.SortFields.Add Key:=Range(Cells(2, 1), Cells(Nrow, 1)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    Asheet.Sort.SortFields.Add Key:=Range(Cells(2, 2), Cells(Nrow, 2)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    Asheet.Sort.SortFields.Add Key:=Range(Cells(2, 3), Cells(Nrow, 3)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    'Вызов метода сортировки с установленными параметрами
    With Asheet.Sort
        .SetRange myrng
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    'Все, диапазон отсортирован'
    'Делаем очистку ячеек справа от таблицы'
    Range(Cells(2, 7), Cells(Nrow, 30)).Select 'выделяем ячейки G2 - T Nrow
 
    Selection.ClearContents
 
    Range(Cells(1, 14), Cells(1, 50)).Select 'выделяем ячейки 1 строки
 
    Selection.ClearContents
    'Очистка области внизу
    Range(Cells(Nrow + 10, 1), Cells(Nrow + 200, 20)).Select 'выделяем ячейки
    Selection.ClearContents
 
    'Далее, выбираем № строки с которой начинается давление = 0,1 и заканчивается
 
    ' кол-во точек в Т зависимости, начальная строка и конечная строка диапазано
    ' расчета Т зависимости в общем отсортированном по давлению диапазоне данных
 
    Dim count, finish, start As Integer
    Dim i
    count = 0
    For i = 2 To Nrow
        If Cells(i, 1).Value = 0.1 Then
            count = count + 1 'количество таких строк
            finish = i 'номер последней строки
        End If
    Next
    start = finish - count + 1 'номер первой строки
 
    If count >= TDepMinCntDots Then
        'Задаем заголовки для столбцов
        Asheet.Cells(2, 6).Value = "Замечания"
        Asheet.Cells(2, 7).Value = "Lg (T)"
        Asheet.Cells(2, 8).Value = "Lg (D)"
        Asheet.Cells(2, 9).Value = "D(T)"
        Asheet.Cells(2, 10).Value = "%"
        Asheet.Cells(2, 13).Value = "НАЧ."
 
        Asheet.Cells(start, LGTclmn).Select
        ActiveCell.FormulaR1C1 = "=LOG10(RC[-5])" 'Внимательно проверить номер столбца из которого берем значение
        'должен быть столбец 2 (B) - значения температуры
 
        Cells(start, LGTclmn).Select 'Выделяем ячейку с формулой
        'Растягиваем направо (Log10(D))
        Selection.AutoFill Destination:=Range(Cells(start, LGTclmn), Cells(start, LGTclmn + 1)), Type:=xlFillDefault
        'Выделяем обе ячейки
        Range(Cells(start, LGTclmn), Cells(start, LGTclmn + 1)).Select
        'Расстягиваем вниз до конца диапазона с 0.1 МПА
        Selection.AutoFill Destination:=Range(Cells(start, LGTclmn), Cells(finish, LGTclmn + 1)), Type:=xlFillDefault
 
 
        '//Расчет коэффициентов линейной регрессии
        'ActiveCell.FormulaR1C1 = "=INDEX(LINEST(R7C8:R19C8,R7C7:R19C7^{1}),1,2)" 'работало
        Dim numstr As String
        Xstr = "R" & CStr(start) & "C" & CStr(LGTclmn) & ":R" & CStr(finish) & "C" & CStr(LGTclmn) 'XStr = "R7C8:R19C8"
        Ystr = "R" & CStr(start) & "C" & CStr(LGTclmn + 1) & ":R" & CStr(finish) & "C" & CStr(LGTclmn + 1) 'Ystr = "R7C7:R19C7"
        Cells(1, 15).Select  'ячейка для 1 коэффициента
        'Cells(2, 15).Value = "B"
        ActiveCell.NumberFormat = "#0.000"
        ActiveCell.FormulaR1C1 = "=INDEX(LINEST(" & Ystr & "," & Xstr & "^{1}),1,2)"
 
        Cells(1, 14).Select ' Ячейка для второго коэффициента
        'Cells(2, 14).Value = "n"
 
 
        ActiveCell.FormulaR1C1 = "=INDEX(LINEST(" & Ystr & "," & Xstr & "^{1}),1,1)"
        ActiveCell.NumberFormat = "#0.000"
        
        Cells(1, 16).Value = count
        'Cells(2, 16).Value = "кол-во точек"
 
        '//Расчет коэффициентов квадратичной регрессии
         Cells(1, 25).Select  'ячейка для свободного коэффициента кв регрессии
         ActiveCell.NumberFormat = "#0.000"
         ActiveCell.FormulaR1C1 = "=INDEX(LINEST(" & Ystr & "," & Xstr & "^{1,2}),1,3)"
         Cells(1, 26).Select  'ячейка для  коэффициента 1 степени кв регрессии
         ActiveCell.NumberFormat = "#0.000"
         ActiveCell.FormulaR1C1 = "=INDEX(LINEST(" & Ystr & "," & Xstr & "^{1,2}),1,2)"
         Cells(1, 27).Select  'ячейка для  коэффициента 2 степени кв регрессии
         ActiveCell.NumberFormat = "#0.000"
         ActiveCell.FormulaR1C1 = "=INDEX(LINEST(" & Ystr & "," & Xstr & "^{1,2}),1,1)"
 
        Dim n As Double, b As Double
        n = Round(Cells(1, 14).Value, NumDigtsAD_nB)
        b = Round(Cells(1, 15).Value, NumDigtsAD_nB)
        Dim n1 As Double, n2 As Double, n0 As Double
        
        n0 = Round(Cells(1, 25).Value, NumDigtsAD_nB)
        n1 = Round(Cells(1, 26).Value, NumDigtsAD_nB)
        n2 = Round(Cells(1, 27).Value, NumDigtsAD_nB)
        
        'Чтобы в ячейках лежали значения, не формулы
        Cells(1, 14).Value = n
        Cells(1, 14).NumberFormat = "#0." + String(NumDigtsAD_nB, "0")
        Cells(1, 15).Value = b
        Cells(1, 15).NumberFormat = "#0." + String(NumDigtsAD_nB, "0")
        
        Cells(1, 25).Value = n0
        Cells(1, 25).NumberFormat = "#0." + String(NumDigtsAD_nB, "0")
        Cells(1, 26).Value = n1
        Cells(1, 26).NumberFormat = "#0." + String(NumDigtsAD_nB, "0")
        Cells(1, 27).Value = n2
        Cells(1, 27).NumberFormat = "#0." + String(NumDigtsAD_nB, "0")
        
        
        ' Делать расчет по полученной линейной регрессии и считать отклонения от эксперимента
        Asheet.Cells(start, LGTclmn + 2).Select
 
 
 
 
        'задаем формулу в первой ячейке столбца
        Xstr = "=10^(" & CStr(n) & "*RC[-2]+(" & CStr(b) & "))"
        Xstr = Replace(Xstr, ",", ".")
        ActiveCell.FormulaR1C1 = Xstr
        Asheet.Cells(start, LGTclmn + 3).Select
        ActiveCell.FormulaR1C1 = "=((RC[-7]-RC[-1])/RC[-1])*100"
        'ActiveCell.Value = Round(ActiveCell.Value, NumDigtsAD_dev)
        ActiveCell.NumberFormat = "#0." + String(NumDigtsAD_dev, "0")
        'Выделяем обе ячейки
        Range(Cells(start, LGTclmn + 2), Cells(start, LGTclmn + 3)).Select
        'Расстягиваем вниз до конца диапазона с 0.1 МПА
        Selection.AutoFill Destination:=Range(Cells(start, LGTclmn + 2), Cells(finish, LGTclmn + 3)), Type:=xlFillDefault
 
        'Расчитаем среднее арифметическое отклонение эксп. точек от зависимости и сразу отследим номера выпадающих точек
        Dim count_disp, sum
        Recommend_disp_cnt = 0
        sum = 0
        'Делаем строку источников - литературу
        Dim literature, source As String
        literature = ""
        For i = start To finish
            sum = sum + Abs(Cells(i, LGTclmn + 3).Value) ' считаем общую сумму с учетом выпадающих точек
            If Abs(Cells(i, LGTclmn + 3).Value) > TDepDevLevel Then
                Recommend_disp_cnt = Recommend_disp_cnt + 1 'количество выбрасываемых точек
                disposing = disposing & CStr(i) & "+" 'номер строки
                Cells(i, LGTclmn + 3).Value = TDepDevFlag + CStr(Round(Cells(i, LGTclmn + 3).Value, 2))
            End If
            source = Cells(i, 4).Value
            literature = literature & (source) & ","
        Next
 
        Dim m, K As Integer
        Dim new_lierature, str, strzpt As String
        Dim SortLit(100) As String
        ''________literature
        K = 0
        m = 1
        new_literature = ""
        Do While m > 0
            m = InStr(literature, ",")
            If m > 0 Then
                str = Left(literature, m - 1)
                If Not (str = "") Then
                    SortLit(K) = LTrim(str)
                    K = K + 1
                    new_literature = new_literature + LTrim(str) + ","
                End If
                strzpt = Left(literature, m)
                literature = Replace(literature, strzpt, "", 1)
 
 
            End If
        Loop
 
        literature = new_literature
        ''сортировка
        Dim j As Integer
        For j = 0 To (K - 1) - 1
            For i = 0 To j - 1
                If SortLit(i) > SortLit(i + 1) Then
                    str = SortLit(i)
                    SortLit(i) = SortLit(i + 1)
                    SortLit(i + 1) = str
 
                End If
            Next
 
        Next
        ''__---------------------------------------------------------------------------______OFF literature
 
        literature = ""
        For i = 0 To K - 1
            literature = literature + SortLit(i) + ", "
        Next
        literature = Left(literature, Len(literature) - 2)
 
        sum = sum / count
        'среднее отклонение эксп. точек от полученной Тдеп
        Cells(1, 17).Value = sum
        Cells(1, 17).NumberFormat = "#0." + String(NumDigtsAD_dev, "0")
        'число точек, рекомендуемых к выбрасыванию
        Cells(1, 18).Value = Recommend_disp_cnt
        'строка источников
        Cells(1, 19).Value = literature
        'общее число точек в расчете
        Cells(1, 20).Value = count
        'число выброшенных точек из расчета
        Cells(1, 23).Value = 0
        'диапазон температур
        'Cells(1, 21).Value = Cells(start, 2).Value
        'Cells(1, 22).Value = Cells(finish, 2).Value
 
        Dim T1, T2
        T1 = Cells(start, 2).Value
        T2 = Cells(finish, 2).Value
 
 
        Cells(1, 21).Value = T1
        Cells(1, 22).Value = T2
 
 
        'Cells(2, 17).Value = "Ср.откл."
        'Cells(2, 18).Value = "Выпадает"
        'Cells(2, 19).Value = "Источники"
        'Cells(2, 20).Value = "Исх. точек"
        'Cells(2, 21).Value = "T1"
        'Cells(2, 22).Value = "T2"
        'Копируем в 2 строку - начальный расчет
        Cells(2, 14).Value = Cells(1, 14)
        Cells(2, 14).NumberFormat = "#0." + String(NumDigtsAD_nB, "0")
        Cells(2, 15).Value = Cells(1, 15)
        Cells(2, 15).NumberFormat = "#0." + String(NumDigtsAD_nB, "0")
        Cells(2, 16).Value = Cells(1, 16)
        Cells(2, 17).Value = Cells(1, 17)
        Cells(2, 17).NumberFormat = "#0." + String(NumDigtsAD_dev, "0")
        Cells(2, 18).Value = Cells(1, 18)
        Cells(2, 19).Value = Cells(1, 19)
        Cells(2, 20).Value = Cells(1, 20)
        Cells(2, 21).Value = Cells(1, 21)
        Cells(2, 22).Value = Cells(1, 22)
        Cells(2, 23).Value = 0
        'уточняем значения строк
        'Cells(3, 13).Value = "ПРЕД."
        'Cells(4, 13).Value = "НАЧ."
        'Выделяем необходимость пересчета
        If Recommend_disp_cnt > 0 Then
            Cells(1, 18).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 255
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        End If
    End If
End Sub

@Казанский · 13.05.2014, 10:53

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

Надеюсь не достала

Нет, напротив! Приятно видеть, что кто-то применяет программирование к науке, а не к деланию денег из воздуха (игра на бирже, реклама, SEO...).

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

собственнокод

А собственноданные будут, на который можно попробовать?

@marqueemarmot · 13.05.2014, 11:16 **[ТС]**

кидаю почищенный файл. не стала убирать другие макросы обработки, по ним тож могут возникнуть вопросы позже

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

))

Не по теме:

Приятно, когда у человека есть желание делиться навыками (сама преподаю), и приятно, когда есть адекватные ученики, ЖЕЛАЮЩИЕ учиться, а не просто получить оценки/выгоду...

По алгоритмике: открываем файл, на пятом листе - с данными. Запускаем макрос TdepNowThis (он запускает указанный выше макрос для текущего листа).

@marqueemarmot · 14.05.2014, 14:52 **[ТС]**

Казанский, нужна помощь. Туплю. было так:

Visual Basic

Xstr = "R" & CStr(start) & "C" & CStr(LGTclmn) & ":R" & CStr(finish) & "C" & CStr(LGTclmn) 'XStr = "R7C8:R19C8"
        Ystr = "R" & CStr(start) & "C" & CStr(LGTclmn + 1) & ":R" & CStr(finish) & "C" & CStr(LGTclmn + 1) 'Ystr = "R7C7:R19C7"
Cells(1, 15).Select  
ActiveCell.FormulaR1C1 = "=INDEX(LINEST(" & Ystr & "," & Xstr & "^{1}),1,2)"
Cells(1, 14).Select 
ActiveCell.FormulaR1C1 = "=INDEX(LINEST(" & Ystr & "," & Xstr & "^{1}),1,1)"

хочу сделать так, чтобы индекс(линейн(....)) считалось над массивами/диапазонами в вба - без помещения на лист. Не понимаю как. Вроде бы закинула диапазоны в массивы (временная мера, потом в динамические диапазоны/массивы значения в цикле запихну), только не пойму зачем хД. Главный вопрос: Как и что теперь передать в индекс(линейн(....)) и как ее вызвать?

Visual Basic

       Dim lgT(), lgD()
        Dim Rng As Range
        Set Rng = Range(Cells(start, LGTclmn), Cells(finish, LGTclmn))
        lgT = Rng.Value2
        Set Rng = Range(Cells(start, LGTclmn + 1), Cells(finish, LGTclmn + 1))
        lgD = Rng.Value2

Добавлено через 42 минуты
сделала:

Visual Basic

        Dim lgT(), lgD()
        Dim Rng As Range
        Set Rng = Range(Cells(start, LGTclmn), Cells(finish, LGTclmn))
        lgT = Rng.Value2
        Set Rng = Range(Cells(start, LGTclmn + 1), Cells(finish, LGTclmn + 1))
        lgD = Rng.Value2
        Dim la As Double, lb As Double
        la = WorksheetFunction.Index(WorksheetFunction.LinEst(lgD, lgT), 1, 2)
        lb = WorksheetFunction.Index(WorksheetFunction.LinEst(lgD, lgT), 1, 1)

проверила, все ок

ну теперь попричесываю код расчетов

))

@Казанский · 14.05.2014, 14:58

Посмотрите этот пример. Пройдите программу по шагам (F8), наблюдайте за переменными в окне Locals (View - Locals window).
Функция ЛИНЕЙН возвращает массив. Чтобы выгрузить массив на лист, не нужно извлекать отдельные элементы функций ИНДЕКС, лучше сразу.

@marqueemarmot · 15.05.2014, 13:03 **[ТС]**

Я в принципе поняла это, парясь по мсдну. Спасибо. Завтра буду уже ваять обработку...

Добавлено через 19 часов 3 минуты

Visual Basic

Option Explicit ' Требует явного объявления всех переменных в файле или позволяет неявного объявления переменных.
 
Sub test()
Dim x(), y(), res()
  '1-й способ формирования диапазона
x = Cells(1, 5).Resize(5).Value
  '2-й способ формирования диапазона
  'способов гораздо больше...
y = Range(Cells(1, 6), Cells(5, 6)).Value
res = Application.LinEst(y, x)
  'выгрузка массива как есть
Cells(2, 8).Resize(, 2).Value = res
  'выгрузка транспонтрованного массива
Cells(4, 8).Resize(2).Value = Application.Transpose(res)
 
End Sub

Typemismatch (RTE 13) на строке

Visual Basic

1	res = Application.LinEst(y, x)

у меня работает только через Worksheetfunction. Что как и почему

Добавлено через 1 час 53 минуты
Итак. то, что получилось для расчета линейной и квадратичной регресии:

Visual Basic

 Dim ind As Integer, i As Integer
        Dim lgT(), lgD()
        Dim lgT2()
        ReDim lgT(count)
        ReDim lgD(count)
        ReDim lgT2(count)
        ind = start
        For i = 1 To count
            lgT(i) = Log(.Cells(ind, 2).Value) / Log(10)
            lgT2(i) = lgT(i) ^ 2
            lgD(i) = Log(.Cells(ind, 3).Value) / Log(10)
            ind = ind + 1
        Next
        Dim linC(), sqrC()
        linC = Application.WorksheetFunction.LinEst(lgD, lgT)
        sqrC = WorksheetFunction.LinEst(lgD, Array(lgT, lgT2))

Напрягает то, что так и не получилось сделать как-то так:

Visual Basic

1	sqrC = LinEst(lgD, Power(lgT, Array(1, 2)))

Вот эти варианты никак не работают. Тоtype mismatch, то Нет свойства LinEst...

Visual Basic

1
2

 'sqrC = Application.WorksheetFunction.LinEst(lgD, Application.Power(Application.Transpose(lgT), Array(1, 2)))
        'sqrC = Application.WorksheetFunction.LinEst(lgD, WorksheetFunction.Transpose(Application.WorksheetFunction.Power(Application.WorksheetFunction.Transpose(lgT), Array(1, 2))))

И пожалуйста, объясните мне, почему у кого то работает вызовApplication.Linest, а у кого-то только через WorksheetFunction

@Казанский · 19.05.2014, 09:44

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

и не получилось сделать как-то так

В файле показал, как это делать, двумя способами.

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

почему у кого то работает вызовApplication.Linest, а у кого-то только через WorksheetFunction

У меня в 2000 и в 2007 работает и то, и другое.
Разница в следующем: если при вычислении функции возникает ошибка, WorksheetFunction.Func вызывает ошибку VBA, а Application.Func возвращает Variant/Error.
Поэтому в первом случае необходимо предусмотреть обработчик ошибок, а во втором случае после вызова надо проверять If IsError(...) Then

Excel: Вызов функций Application из тела функции

Решение

Решение

@marqueemarmot 1 / 1 / 0 Регистрация: 08.05.2014 Сообщений: 19
	08.05.2014, 10:25 [ТС]	3
	Казанский, спасибо. думала об этом, но не нашла информации... (а есть линк, где это написано, мсдн, или хотя б книжка какая?) Вообще-то не очень логично, конечно... как раз думала о том, чтобы другая функция в зависимости от некоторых результатов внутри себя (не возвращаемого значения) окрашивала ячейку, в которой я ее вызываю, или хотя бы хинт делала.. это реально как-то сделать? 0

@Казанский 15151 / 6424 / 1731 Регистрация: 24.09.2011 Сообщений: 9,999
	08.05.2014, 10:50	4
	marqueemarmot, почитайте Вытянуть данные из закрытых книг в Excel Красить ячейку можно условным форматированием. 1

@marqueemarmot 1 / 1 / 0 Регистрация: 08.05.2014 Сообщений: 19
	08.05.2014, 10:58 [ТС]	5
	не выйдет, поскольку окрашивать хочу не по результатам, возвращаемым функцией. Объясняю. Логика такая, считаем некое A=F(x,y). При этом есть некая функция B(x,y), которая определяет насколько достоверно пользоваться функцией A=F(x,y). Вот и хотелось бы, когда достоверность низкая, чтобы он окрашивал результат. Можно конечно в соседнем столбце отдельно определять достоверность и в соответствии с ней окрашивать, но это очень неудобно, потому, что даже А - это лишь промежуточные вычисления, и загромождать лист не хочется. Опять же возможно, я и приду к тому, что все расчеты делать на другом листе, копируя туда инфу, и хранить там все промежуточные расчеты, а на исходный лист выводить уже только нужну информацию... но это крайне неудобно 0

@Казанский 15151 / 6424 / 1731 Регистрация: 24.09.2011 Сообщений: 9,999
	08.05.2014, 13:16	6
	marqueemarmot, пользовательскую функцию можно использовать в условном форматировании. И почему бы все расчеты не делать в VBA, а на лист только результаты выводить? 0

@marqueemarmot 1 / 1 / 0 Регистрация: 08.05.2014 Сообщений: 19
	09.05.2014, 12:45 [ТС]	7
	ну, многое проще уже встроенными функциями Экселя, скажем линейную и квадратичную аппроксимацию. А так вобщем-то на лист и вывожу только то, что нужно. Просто работа исследовательская и часть "условно промежуточных" данных важна для анализа. пользовательскую функцию можно использовать в условном форматировании ок, спасибо, попробую 0

@Казанский 15151 / 6424 / 1731 Регистрация: 24.09.2011 Сообщений: 9,999
	09.05.2014, 13:03	8
	Сообщение было отмечено marqueemarmot как решение Решение Сообщение от marqueemarmot многое проще уже встроенными функциями Экселя, скажем линейную и квадратичную аппроксимацию Встроенные функции можно и нужно использовать в VBA! Причем это можно делать двумя способами: функция как метод объекта Application (или объекта Application.Worksheetfuncion), или вызывая интерпретатор формул Evaluate. В этой теме используются оба способа, и даже еще один - [A1:K50] это неявный вызов evaluate("A1:K50"): Удалить 20% максимальных чисел в столбце Excel 2007 0

@marqueemarmot 1 / 1 / 0 Регистрация: 08.05.2014 Сообщений: 19
	12.05.2014, 11:11 [ТС]	11
	почти дошла до этого VBA всегда присваивает новой переменной значение 0/Flalse? я смотрю, комментировано первое присваивание 0

@Казанский 15151 / 6424 / 1731 Регистрация: 24.09.2011 Сообщений: 9,999
	12.05.2014, 14:40	13
	Сообщение от marqueemarmot VBA всегда присваивает новой переменной значение 0/Flalse? Да. Сообщение от F1 - Dim Statement When variables are initialized, a numeric variable is initialized to 0, a variable-length string is initialized to a zero-length string (""), and a fixed-length string is filled with zeros. Variant variables are initialized to Empty. Each element of a user-defined type variable is initialized as if it were a separate variable. Идентификатор функции внутри функции - та же самая переменная. Сообщение от marqueemarmot Попробовала вставить в условное форматирование как формулу, переправил мне формулу (ссылки в ней) на не пойми куда: было RC[-4] стало RC[16380] Наверно, ко всей строке УФ применили. В этом случае Excel меняет ссылки как для первой (или последней?) ячейки строки и закольцовывает диапазон, т.е. вместо 0 столбца становится 16384, вместо -1 столбца 16383 и т.д. Попробуйте назначить УФ для ограниченного диапазона ячеек так, чтобы ссылки не уходили за край листа. 0

@Казанский 15151 / 6424 / 1731 Регистрация: 24.09.2011 Сообщений: 9,999
	13.05.2014, 10:53	15
	Сообщение от marqueemarmot Надеюсь не достала Нет, напротив! Приятно видеть, что кто-то применяет программирование к науке, а не к деланию денег из воздуха (игра на бирже, реклама, SEO...). Сообщение от marqueemarmot собственнокод А собственноданные будут, на который можно попробовать? 0