VPF::Ошибка 2015 Application.Evaluate - Форум программистов

masterofmind

Дата 22.4.2009, 17:43 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 19
Регистрация: 1.4.2007

Репутация: нет
Всего: нет

Доброго дня, коллеги.

Т.к. я не являюсь программистом в его сакраментальной трактовке smile

прошу Вас помочь мне разобраться с одной проблемой.
Компилятор VBA Ну никак не хочет кушать вот такую конструкцию:

Код


If Application.Evaluate("=И(СУММ($C6:$E6)>0;СУММ(F6:G6)=0)") Then 
               ActiveCondition = Ndx
               Exit Function
            End If

Ошибка 2015 - Type mismatch

3 часа угробил - не могу понять, что не так.

Данный код, лишь фрагмент функции- не мой, взят с сайта http://www.cpearson.com.

Моя задача - получить цвет ячейки окрашенной условным форматированием. Соответсвенно цвет и кол-во ячеек будет постоянно меняться. Мне нужна была функция, которая бы это все считала. У уважаемого коллеги, чей сайт я выложил выше - все работает, но к сожалению на простых формулах, типа "=100" и т.д. С моей же формулой - не хочет ;-(. Сама формула - рабочая, условное форматирование по ней отрабатывает четко.

Выкладывю текст самих функций:

Код


Function RangeOfColor(TestRange As Range, _
    ColorIndex As Long, Optional OfText As Boolean = False) As Range
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' RangeOfColors
' This function returns a Range object containing the individual cells of
' TestRange whose Font (if OfText is True) or Interior (if OfText is False or
' omitted) has the color index specified by ColorIndex. Note that the function
' may return Nothing.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim R As Range
Dim RR As Range
Dim CI As Long

If ColorIndex = 0 Then
    If OfText = False Then
        CI = xlColorIndexNone
    Else
        CI = xlColorIndexAutomatic
    End If
End If

If ColorIndex <> 0 Then
    If IsValidColorIndex(ColorIndex) = False Then
        Exit Function
    End If
End If

For Each R In TestRange.Cells
    If OfText = False Then
        If R.Interior.ColorIndex = CI Then
            If RR Is Nothing Then
                Set RR = R
            Else
                Set RR = Application.Union(RR, R)
            End If
        End If
    Else
        If RR Is Nothing Then
            Set RR = R
        Else
            Set RR = Application.Union(RR, R)
        End If
    End If
Next R
Set RangeOfColor = RR

End Function

Function ColorNameOfRGB(RGBLong As Long) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ColorNameOfRGB
' Returns the name of the color specified by RGBLong
' if RGBLong is in the application default pallet.
' Otherwise, returns vbNullString.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim n As Long
Dim V As Variant
If IsValidRGBLong(RGBLong) = False Then
    Exit Function
End If
V = Application.Match(RGBLong, ThisWorkbook.Colors, 0)
If IsError(V) = True Then
    Exit Function
End If

V = DefaultColorNames(V)
If V <> vbNullString Then
    ColorNameOfRGB = V
End If

End Function

Function ActiveCondition(Rng As Range) As Integer
Dim Ndx As Long
Dim FC As FormatCondition
Dim Temp As Variant
Dim Temp2 As Variant

If Rng.FormatConditions.Count = 0 Then
    ActiveCondition = 0
Else
    For Ndx = 1 To Rng.FormatConditions.Count
        Set FC = Rng.FormatConditions(Ndx)
        Select Case FC.Type
            Case xlCellValue
            Select Case FC.Operator
                Case xlBetween
                    Temp = GetStrippedValue(FC.Formula1)
                    Temp2 = GetStrippedValue(FC.Formula2)
                    If IsNumeric(Temp) Then
                       If CDbl(Rng.Value) >= CDbl(FC.Formula1) And _
                           CDbl(Rng.Value) <= CDbl(FC.Formula2) Then
                           ActiveCondition = Ndx
                           Exit Function
                       End If
                   Else
                      If Rng.Value >= Temp And _
                         Rng.Value <= Temp2 Then
                         ActiveCondition = Ndx
                         Exit Function
                      End If
                   End If

                Case xlGreater
                    Temp = GetStrippedValue(FC.Formula1)
                    If IsNumeric(Temp) Then
                       If CDbl(Rng.Value) > CDbl(FC.Formula1) Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    Else
                       If Rng.Value > Temp Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    End If

                Case xlEqual
                    Temp = GetStrippedValue(FC.Formula1)
                    If IsNumeric(Temp) Then
                       If CDbl(Rng.Value) = CDbl(FC.Formula1) Then
                           ActiveCondition = Ndx
                           Exit Function
                       End If
                    Else
                       If Temp = Rng.Value Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    End If


                Case xlGreaterEqual
                    Temp = GetStrippedValue(FC.Formula1)
                    If IsNumeric(Temp) Then
                       If CDbl(Rng.Value) >= CDbl(FC.Formula1) Then
                           ActiveCondition = Ndx
                           Exit Function
                       End If
                    Else
                       If Rng.Value >= Temp Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    End If

              
                Case xlLess
                    Temp = GetStrippedValue(FC.Formula1)
                    If IsNumeric(Temp) Then
                        If CDbl(Rng.Value) < CDbl(FC.Formula1) Then
                           ActiveCondition = Ndx
                           Exit Function
                        End If
                    Else
                        If Rng.Value < Temp Then
                           ActiveCondition = Ndx
                           Exit Function
                        End If
                    End If

                Case xlLessEqual
                    Temp = GetStrippedValue(FC.Formula1)
                    If IsNumeric(Temp) Then
                       If CDbl(Rng.Value) <= CDbl(FC.Formula1) Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    Else
                       If Rng.Value <= Temp Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    End If


                Case xlNotEqual
                    Temp = GetStrippedValue(FC.Formula1)
                    If IsNumeric(Temp) Then
                       If CDbl(Rng.Value) <> CDbl(FC.Formula1) Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    Else
                       If Temp <> Rng.Value Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    End If

               Case xlNotBetween
                    Temp = GetStrippedValue(FC.Formula1)
                    Temp2 = GetStrippedValue(FC.Formula2)
                    If IsNumeric(Temp) Then
                       If Not (CDbl(Rng.Value) <= CDbl(FC.Formula1)) And _
                          (CDbl(Rng.Value) >= CDbl(FC.Formula2)) Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    Else
                       If Not Rng.Value <= Temp And _
                          Rng.Value >= Temp2 Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    End If
            
               Case Else
                    Debug.Print "UNKNOWN OPERATOR"
           End Select


        Case xlExpression
            If Application.Evaluate(FC.Formula1) Then ' Çàáàíèë, èìõî íå ðàáîòàåòü áëÿ ñ òàêèìè ôîðìóëàìè.
            'If FC.Formula1 <> " " Then
                ActiveCondition = Ndx
               Exit Function
            End If

        Case Else
            Debug.Print "UNKNOWN TYPE"
       End Select

    Next Ndx

End If

ActiveCondition = 0



End Function
 

'''''''''''''''''''''''''''''''''''''''


Function ColorIndexOfCF(Rng As Range, _
    Optional OfText As Boolean = False) As Integer

Dim AC As Integer
AC = ActiveCondition(Rng)
If AC = 0 Then
    If OfText = True Then
       ColorIndexOfCF = Rng.Font.ColorIndex
    Else
       ColorIndexOfCF = Rng.Interior.ColorIndex
    End If
Else
    If OfText = True Then
       ColorIndexOfCF = Rng.FormatConditions(AC).Font.ColorIndex
    Else
       ColorIndexOfCF = Rng.FormatConditions(AC).Interior.ColorIndex
    End If
End If

End Function
 

'''''''''''''''''''''''''''''''''''''''


Function ColorOfCF(Rng As Range, Optional OfText As Boolean = False) As Long

Dim AC As Integer
AC = ActiveCondition(Rng)
If AC = 0 Then
    If OfText = True Then
       ColorOfCF = Rng.Font.Color
    Else
       ColorOfCF = Rng.Interior.Color
    End If
Else
    If OfText = True Then
       ColorOfCF = Rng.FormatConditions(AC).Font.Color
    Else
       ColorOfCF = Rng.FormatConditions(AC).Interior.Color
    End If
End If

End Function

'''''''''''''''''''''''''''''''''''''''

Function GetStrippedValue(CF As String) As String
    Dim Temp As String
    If InStr(1, CF, "=", vbTextCompare) Then
       Temp = Mid(CF, 3, Len(CF) - 3)
       If Left(Temp, 1) = "=" Then
           Temp = Mid(Temp, 2)
       End If
    Else
       Temp = CF
    End If
    GetStrippedValue = Temp
End Function
 

'''''''''''''''''''''''''''''''''''''''

Function CountOfCF(InRange As Range, _
    Optional Condition As Integer = -1) As Long
    Dim Count As Long
    Dim Rng As Range
    Dim FCNum As Integer

    For Each Rng In InRange.Cells
        FCNum = ActiveCondition(Rng)
        If FCNum > 0 Then
            If Condition = -1 Or Condition = FCNum Then
                Count = Count + 1
            End If
        End If
    Next Rng
    CountOfCF = Count
End Function

'''''''''''''''''''''''''''''''''''''''

Function SumByCFColorIndex(Rng As Range, CI As Integer) As Double
    Dim R As Range
    Dim Total As Double
    For Each R In Rng.Cells
        If ColorIndexOfCF(R, False) = CI Then
            Total = Total + R.Value
        End If
    Next R
    SumByCFColorIndex = Total
End Function

Если кому-то пригодится-буду только рад. Если у кого есть свои наработки - прошу поделится. На поиски кода нашего зарубежноо коллеги у меня ушло 5 часов. ;)
Прошу помощи.

Это сообщение отредактировал(а) masterofmind - 22.4.2009, 17:52

Akina

Дата 22.4.2009, 18:01 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 26
Всего: 454

Цитата(Встроенный хелп)

Evaluate Method

Converts a Microsoft Excel name to an object or a value.

expression.Evaluate(Name)

expression Optional for Application, required for Chart, DialogSheet, and Worksheet. An expression that returns an object in the Applies To list.

Name Required String. The name of the object, using the naming convention of Microsoft Excel.

То есть Name - это имя (наименование) объекта, а не формула.

--------------------

О(б)суждение моих действий - в соответствующей теме, пожалуйста. Или в РМ. И высшая инстанция - Администрация форума.

masterofmind

Дата 22.4.2009, 18:07 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 19
Регистрация: 1.4.2007

Репутация: нет
Всего: нет

Почему тогда в такая конструкция:

Код


 Case xlExpression
            If Application.Evaluate(FC.Formula1) Then
            ActiveCondition = Ndx
               Exit Function
            End If

при

Код


FC.Formula1="=И(СУММ($C6:$E6)>0;СУММ(F6:G6)=0)"

У меня не срабатывает, а при другом условии на значении - все ок?
Например вот таком:

Код


FC.Formula1=">100"

Проверял неоднократно в отладчике. Брал 2 ячейки с разным условным форматированием. На 1 не работает, на 2 - работает.

Это сообщение отредактировал(а) masterofmind - 22.4.2009, 18:09

Akina

Дата 22.4.2009, 21:20 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 26
Всего: 454

Цитата(masterofmind @ 22.4.2009, 19:07

)

а при другом условии на значении

Блин, каком??? мы что тут, телепаты???

--------------------

masterofmind

Дата 23.4.2009, 08:44 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 19
Регистрация: 1.4.2007

Репутация: нет
Всего: нет

Я же указал при каком...

Akina

Дата 23.4.2009, 08:47 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 26
Всего: 454

Цитата(masterofmind @ 22.4.2009, 19:07

)

Брал 2 ячейки с разным условным форматированием. На 1 не работает, на 2 - работает.

Просто прелестное указание.

--------------------

masterofmind

Дата 23.4.2009, 08:58 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 19
Регистрация: 1.4.2007

Репутация: нет
Всего: нет

Цитата

Цитата(masterofmind @ 22.4.2009, 19:07 Найти цитируемый пост)
Брал 2 ячейки с разным условным форматированием. На 1 не работает, на 2 - работает.

Просто прелестное указание.

Извиняюсь, может спешил, и неверно выразился, вот они :

Цитата

при
Выделить всёкод Visual Basic
1:

FC.Formula1="=И(СУММ($C6:$E6)>0;СУММ(F6:G6)=0)"

У меня не срабатывает, а при другом условии на значении - все ок?
Например вот таком:
Выделить всёкод Visual Basic
1:

FC.Formula1=">100"

Т.е. эти формулы и являлись условиями для форматирования ячеек. На этих значениях я запускал функцию.

Причину ошибки отловил - при добавление в условное форматирование ячейки вычисляемой формулы (на русском, т.к. excel 2007 русский) - функция начинает отваливаться при вызове Application.Evaluate(FC.formula1) с той же самой ошибкой. При этом на листе - все прекрасно работает. Функция работает также при простых условиях типа - <,>,= <> и т.д. применяемых к ячейкам, т.е. вызов Application.Evaluate(FC.formula1) проходит корректно.

Как победить ошибку - не знаю.

Помогите пожалуйста, данный функционал очень нужен.

Это сообщение отредактировал(а) masterofmind - 23.4.2009, 09:02

Akina

Дата 23.4.2009, 09:05 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 26
Всего: 454

Замените русские имена на аглицкие... для конвертации можно использовать как статику (FUNC.XLS), так и временную ячейку

Код


strFormula = "=И(СУММ($C6:$E6)>0;СУММ(F6:G6)=0)"
strTemp = Range("a1").FormulaLocal
Range("a1").FormulaLocal = strFormula
strFormula = Range("a1").Formula
Range("a1").FormulaLocal = strTemp

--------------------

masterofmind

Дата 23.4.2009, 09:23 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 19
Регистрация: 1.4.2007

Репутация: нет
Всего: нет

Огромный респект Akina!

Все работает!

Единственная просьба, можно маленький ликбез - почему так получается? Дабы не флудить более и знать корни.

Цитата

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

Да и еще вопрос - на больших объемах данных, не скажется ли такой метод на быстродействии?

Прошу прощения сразу - я не программист, я логист аналитик. А вот кодить, как говорится жизнь заставила...;) Хорошо в юности увлекался. ;)

Это сообщение отредактировал(а) masterofmind - 23.4.2009, 09:25

Akina

Дата 23.4.2009, 09:31 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 26
Всего: 454

Цитата(masterofmind @ 23.4.2009, 10:23

)

почему так получается?

Внимательно читаем справку по тому, чем отличаются formula от formulalocal - этого должно хватить.

Цитата(masterofmind @ 23.4.2009, 10:23

)

на больших объемах данных, не скажется ли такой метод на быстродействии?

На больших объёмах данных Эксель - неправильный инструмент для работы. Вопрос лишён смысла.

--------------------

masterofmind

Дата 23.4.2009, 10:33 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 19
Регистрация: 1.4.2007

Репутация: нет
Всего: нет

Ну и еще один вопрос в тему-как преобразовать формулу, на основании ячейки. Т.е. подставить в неё относительные ссылки, на основании текущей ячейки?

Код


formula = "=И(СУММ($C6:$E6)>0;СУММ(F6:G6)=0)"
        
        strTemp = Range("XX1").FormulaLocal
        Range("XX1").FormulaLocal = formula
        formula = Range("XX1").formula
        Range("XX1").FormulaLocal = strTemp


new_formula = Application.ConvertFormula(formula, xlA1, xlA1, False, Лист1.Cells(20, 7))

Вот такой код - не работает. Я не правильно вызываю функцию конверта?

Должна вернуть вот так - И(СУММ($C20:$E20)>0;СУММ(F20:G20)=0)

Akina

Дата 23.4.2009, 10:43 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 26
Всего: 454

Цитата(masterofmind @ 23.4.2009, 11:33

)

Я не правильно вызываю функцию конверта?

Да, неправильно. Читайте справку.

--------------------

masterofmind

Дата 23.4.2009, 15:47 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 19
Регистрация: 1.4.2007

Репутация: нет
Всего: нет

Akina, ну сжальтесь. Я же писал, я не программист, но поставленную задачу нужно выполнить.

Хоть убейте, не пойму как мне вычислить формулу относительно текущей ячейки. Метод application.convertformula уже и так и эдак, все не получается.

В свойсве FormatCondition.formula - содержится формула которая задается при условном форматировании. Она едина и неизменна для всего диапазона. Эксель же при применении усл. формата сам подменяет и расчитывает его для каждой ячейки. Мне нужно сделать тоже самое, как?

Вот пример:

нужно расчитать её к примеру для ячейки "G50".

Вот так - не получается:
FC.Formula1= "=И(СУММ($C6:$E6)>0;СУММ(F6:G6)=0)"

Код


      
   strFormula = FC.Formula1
        strTemp = Range("NN1").FormulaLocal
        Range("NN1").FormulaLocal = strFormula
        strFormula = Range("NN1").formula
        Range("NN1").FormulaLocal = strTemp
        strFormula = Application.ConvertFormula(strFormula, xlA1, xlA1, False, rng)
        
        
            
             If Application.Evaluate(strFormula) Then
              ActiveCondition = Ndx
                 Exit Function
            End If

rng - as Range, ячейка передаваемая при вызове функции. Т.е. он содержит ссылку на текущую ячейку.
FC=rng.FormatConditions(Ndx) - тут я думаю понятно, ndx - счетчик условных форматов для ячейки.
Что я делаю не так? Прошу, помогите.

Это сообщение отредактировал(а) masterofmind - 23.4.2009, 15:59

Akina

Дата 23.4.2009, 16:21 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 26
Всего: 454

Цитата(masterofmind @ 23.4.2009, 16:47

)

Код


strFormula = Application.ConvertFormula(strFormula, xlA1, xlA1, False, rng)

Повторяю - читайте справку. Конкретно - на месте False должно стоять совершенно иное значение.

Цитата(masterofmind @ 23.4.2009, 16:47

)

Я же писал, я не программист, но поставленную задачу нужно выполнить.

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

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Программирование, связанное с MS Office \| Следующая тема »