Страницы: 1
RSS
Application.Evaluate
 
Ребят, подскажите можно ли формулу в макрос записать так
Код
 Min = Application.Evaluate("=SMALL(Range(Cells(RowStart,2),Cells(LastRow,2)),COUNTIF(Range(Cells(RowStart,2),Cells(LastRow,2)),0)+1)")
Кидаю еще код
Код
Sub Macro2()
Dim iMin As Double, j As Long

 Raznica = (Cells(1, 4) + 100) / 100
 LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    RowStart = 2
    
     For i = RowStart To LastRow
     Min = Application.Evaluate("=SMALL(Range(Cells(RowStart,2),Cells(LastRow,2)),COUNTIF(Range(Cells(RowStart,2),Cells(LastRow,2)),0)+1)")
       If Sheets(1).Cells(i, 2) = 0 Then
           Sheets(1).Cells(i, 2).Interior.Color = RGB(227, 20, 20)
           Else
                     If Sheets(1).Cells(i, 2) / Min > Raznica Then 'тут ругается
                            Sheets(1).Cells(i, 2).Interior.Color = RGB(227, 20, 20)
                End If
                 End If
              Next
                             

End Sub 
если указываю конкретные диапазоны в формуле то все хорошо, но мне нужно чтобы диапазон определялся динамически.
Подскажите пожалуйста как сделать?
 
А зачем  формула, если пишите макрос?
И словами опишите, что вы хотите закрасить и при каких условиях?
 
Пора бы уже и синтаксис VBA начать учить и работу с переменными.
Код
"=SMALL(" & Range(Cells(RowStart,2),Cells(LastRow,2)).Address & ",COUNTIF(" & Range(Cells(RowStart,2),Cells(LastRow,2)).Address & ",0)+1)"


Плюс можно без Evaluate напрямую вызвать функцию листа:
Код
Min = Application.Small(Range(Cells(RowStart, 2), Cells(LastRow, 2)), Application.CountIf(Range(Cells(RowStart, 2), Cells(LastRow, 2)), 0) + 1)
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Ещё потребуется очищение от заливки, при повторном запуске:
Код
Columns(2).Interior.ColorIndex = xlNone
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
Kuzmich, пишу формулу потому что не хочу использовать цикл=)
 
Так пишу веравно ошибка,там где прежде
Код
Sub Macro2()
Dim iMin As Double, j As Long

 Raznica = (Sheets(1).Cells(1, 4) + 100) / 100
 LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    RowStart = 2
    
     For i = RowStart To LastRow
     Min = Application.Small(Range(Cells(RowStart, 2), Cells(LastRow, 2)), Application.CountIf(Range(Cells(RowStart, 2), Cells(LastRow, 2)), 0) + 1)

       If Sheets(1).Cells(i, 2) = 0 Then
           Sheets(1).Cells(i, 2).Interior.Color = RGB(227, 20, 20)
           Else
                     If Sheets(1).Cells(i, 2) / Min > Raznica Then
                            Sheets(1).Cells(i, 2).Interior.Color = RGB(227, 20, 20)
                End If
                 End If
              Next
                             

End Sub
 
И какая именно ошибка? Деление на 0 происходит?
 
Ребят, так я разобралась, но работает странно, мне все же нужен совет в логичности..все ли я верно делаю. вот код
что мне по сути нужно , есть товар, в рамках одного товара, выявить разницу в цене которая больше на 30% от минимальной и выделить ее цветом...он мне все выделяет цветом
что я делаю :
Код
Sub x()
Dim lLastRow As Long, RowStart As Long, RowFinish As Long
Dim price As Currency
Dim Raznica As Double, iMin As Double, j As Long

 Raznica = (Cells(1, 4) + 100) / 100 'задаю процент 
 LastRow = Cells(Rows.Count, 3).End(xlUp).Row 
 RowStart = 15 ' стартую с 15 ячейки
 Range(Cells(15, 7), Cells(LastRow, 7)).Interior.ColorIndex = xlNone
    For i = RowStart To LastRow
        If Sheets("price").Cells(i + 1, 5) <> Sheets("price").Cells(i, 5) Then 'сравниваю строки если строки разные то
           RowFinish = i 'запоминаю адрес ячейки
               iMin = Application.Small(Range(Sheets("price").Cells(RowStart, 7), Sheets("price").Cells(LastRow, 7)), Application.CountIf(Range(Sheets("price").Cells(RowStart, 7), Sheets("price").Cells(LastRow, 7)), 0) + 1) 'перепрыгиваю на столбец с ценой и ищу там минимальную цену отличную от 0
                For j = RowStart To RowFinish 
                      If Sheets("price").Cells(j, 7) / iMin > Raznica Then ' ищу число большее на 30% от минимального
                            Sheets("price").Cells(j, 7).Interior.Color = RGB(227, 20, 20)
                    End If
                 End If
           Next
            RowStart = i + 1
        End If
Next

End Sub

Кидаю файл, не обращайте внимание на пустые строки это вырезка из файла
Изменено: Lilo_255 - 09.06.2015 17:52:54
 
Эта строка что делает
Код
        If Sheets("price").Cells(i + 1, 5) <> Sheets("price").Cells(i, 5) Then
 
Kuzmich, сравнивает ячейки если они разный то стоп..
 
Вы выделяете подгруппу , а минимум считаете от строки 15 до 41.
По моему минимум и надо считать в пределах одной подгруппы, как у вас закомментировано
 
Kuzmich, спасибо, глупая ошибка
Код
iMin = Application.Small(Range(Sheets("price").Cells(RowStart, 7), Sheets("price").Cells(RowFinish, 7)), Application.CountIf(Range(Sheets("price").Cells(RowStart, 7), Sheets("price").Cells(RowFinish, 7)), 0) + 1)
но что-то дебаг в этой строке
 
Я имел ввиду строку
Код
iMin = Application.WorksheetFunction.Min(Range(Sheets("price").Cells(RowStart, 7), Sheets("price").Cells(RowFinish, 7)))
И снизьте порог с 30 до 20 и ячейки покрасятся
 
все разобралась! всем спасибо!!
Страницы: 1
Читают тему
Наверх