Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Поиск и выбор максимального числа на VBA, Ускорить работу макроса
 
#1
28.03.2013 04:15:39
Доброй ночи,
Прошу помочь ускорить макрос, который написал для следущей цели:
Имеется диапазон чисел в столбике Length и RESULT.
Изходя из столбика X необходимо найти максимальное число из столбика RESULT между двумя X т.е. X соответствует данным из Length.

Предположим по примеру для X=1 X=5 необходимо найти максимальное число из столбика RESULT (равно 2). Потом для X=5 X=9 и т.д.

Я делал при помощи поиска определяя номер строки для X из столбика Length и дальше определив регион для RESULT нахожу максимальное число.
Но, как оказалось, для больших задачь очень медленно работает. Прошу посмотреть пример.
Может есть у кого-то идеи как можно ускорить макрос? Или возможно у меня совершенно все некорректно?

В приложение сам пример и ниже код.
Очень буду благодарен за помощь. Спасибо.

Код
Function FindMyNumber(Length As Range, X As Range, Out As Integer)
    Dim SearchRange_a(), i&, row_a&, row_b&, Value_num&, max_range%

    Value_num = UBound(X.Value) - 1
    ReDim FindRow_a(1 To Value_num)
    ReDim FindRow_b(1 To Value_num)
    ReDim max_value(1 To Value_num)
    
    For i = 1 To Value_num
        Set FindRow_a(i) = Length.Find(Replace(X(i), ".", "."), LookIn:=xlValues)
        Set FindRow_b(i) = Length.Find(Replace(X(i + 1), ".", "."), LookIn:=xlValues)
        
    max_value(i) = Application.Max(Abs(Application.Max(Sheets("Sheet1").Range("B" & FindRow_a(i).Row, "B" & FindRow_b(i).Row))), _
                                   Abs(Application.Min(Sheets("Sheet1").Range("B" & FindRow_a(i).Row, "B" & FindRow_b(i).Row))))
    Next
    FindMyNumber = max_value(Out)
End Function
 
 
 
#2
28.03.2013 04:50:36
А можно по подробнее, что собственно говоря ищется?
Почему при X=3 должно находится 0,3, а не 3 к примеру?
Метод Range.Find ищет с первой строки к последней.
 
 
 
#3
28.03.2013 07:54:22
Цитата
anvg пишет:
Метод Range.Find ищет с первой строки к последней.
Уверены? Не вводите в заблуждение человека. Почитайте про параметр SearchDirection.
There is no knowledge that is not power
 
 
 
#4
28.03.2013 08:24:36
Johny
И где в коде есть SearchDirection?
 
 
 
#5
28.03.2013 08:35:42
Цитата
anvg пишет:
И где в коде есть SearchDirection?
Поясняю.
Вы пишете "Метод Range.Find ищет с первой строки к последней", а надо было "Метод Range.Find может искать в направлении, задаваемом параметром SearchDirection".
There is no knowledge that is not power
 
 
 
#6
28.03.2013 08:49:13
Teklan, Вы пишите, что "...Изходя из столбика X необходимо найти максимальное число из столбика RESULT..."
Между тем в примере функция возвращает числа, которых вообще нет в колонке RESULT. Это как?
Учимся сами и помогаем другим...
 
 
 
#7
28.03.2013 10:43:31
Всем доброе утро.
Прошлый пример не понятно почему, но не работал корректно (надо разбираться).
Поменял исходные данные и вроде все как надо.
По заданию, представим что есть отрезок с координатами X,Y в плоскости и нам надо найти максимальное значение Y между двумя значениями X.
Прошу посмотреть пример. Например в промежутке между X 0 и 5.455 максимальное значение Y 91,03615092.
Думаю так более понятно задание?

П.С. Средствами Excel будет как-то так (но надо на VBA чтобы "впилить" в общий расчет, но дико тормозит):
Код
{=MAX(ABS(MAX(IF(($A$8:$A$2000>=E6)*($A$8:$A$2000<=E7);$B$8:$B$2000)));ABS(MIN(IF(($A$8:$A$2000>=E6)*($A$8:$A$2000<=E7);$B$8:$B$2000))))}
Изменено: Teklan - 28.03.2013 10:46:23
 
 
 
#8
28.03.2013 11:14:23
Цитата
По заданию, представим что есть отрезок с координатами X,Y в плоскости и нам надо найти максимальное значение Y между двумя значениями X.
Тогда так
Код
Public Function FindAbsMax(ByVal X As Range, ByVal Y As Range, ByVal Xbegin As Double, ByVal Xfinish As Double) As Double
    Dim xData As Variant, yData As Variant
    Dim i As Long, vResult As Double, vComp As Double
    xData = X.Value: yData = Y.Value
    If UBound(xData) <> UBound(yData) Then Err.Raise vbObjectError - 1000
    vResult = -1E+300
    For i = 1 To UBound(xData)
        If (xData(i, 1) >= Xbegin) And (xData(i, 1) <= Xfinish) Then
            vComp = Math.Abs(yData(i, 1))
            If vComp > vResult Then vResult = vComp
        End If
    Next i
    FindAbsMax = vResult
End Function

Только тогда зачем используется Out As Integer в параметрах?
 
 
 
#9
28.03.2013 11:20:54
anvg, Сейчас попробую Ваш вариант.
Out было для выводя значения из массива т.е. первое значение, второе и тд. (Во всяком случае я так это видел)
 
 
 
#10
28.03.2013 11:40:26
ИМХО так быстрее:
Код
{  =МАКС(ABS(ИНДЕКС($B$8:$B$2000;ПОИСКПОЗ(E6;$A$8:$A$2000)):ИНДЕКС($B$8:$B$2000;ПОИСКПОЗ(E7;$A$8:$A$2000))))  }
Можете этот же принцип использовать в VBA.
 
 
 
#11
28.03.2013 11:43:24
Цитата
Teklan пишет:
Out было для выводя значения из массива т.е. первое значение, второе и тд.
Для этого вместо МАКС используйте НАИБОЛЬШИЙ с соотв. параметром.
 
 
 
#12
28.03.2013 11:57:21
Казанский, спасибо. Постараюсь запомнить =)
Вариант anvg по моему работает достойно.
 
 
 
#13
28.03.2013 12:13:07
Цитата
Teklan пишет:
Вариант anvg по моему работает достойно
На 2000 - наверно, на 200 тысяч - будет жестоко тормозить.
ПОИСКПОЗ с опущенным последним параметром работает очень быстро при любом размере массива, т.к. использует метод половинного деления или более продвинутый способ, а не просматривает каждый элемент массива (предполагается, что массив отсортирован по возрастанию, что в данном случае справедливо).
Изменено: Казанский - 28.03.2013 12:14:47
 
 
 
#14
28.03.2013 21:17:44
OFF
Цитата
Вариант anvg по моему работает достойно
По тeklan'ски - то не так, как думает Казанский  :)
 
 
 
#15
28.03.2013 22:13:00
Цитата
anvg: Метод Range.Find ищет с первой строки к последней.
Вообще-то, со второй  ;)  
Код
Sub Test()
  With Range("A1:B10")
    .Formula = [{1,"=Row()"}]
    Debug.Print .Columns(1).Find(1, LookIn:=xlValues, LookAt:=xlWhole).Address
  End With
End Sub
Изменено: ZVI - 28.03.2013 22:13:40
 
 
 
#16
29.03.2013 02:43:18
ZVI  :)
Казанский
Так и тут, учитывая почти регулярное приращение по X для приведённого примера, никто не мешает вычислять предварительный индекс Xbegin,Xfinish
Код
    Dim first As Long, last As Long, mult As Double
    Dim idBegin As Long, idFinish As Long
    first = LBound(X.Value): last = UBound(X.Value)
    mult = (last - first) / (xData(last, 1) - xData(first, 1))
    idBegin = (Xbegin - xData(first, 1)) * mult + 1
    idFinish = (Xfinish - xData(first, 1)) * mult + 1

Плюс шаг, другой вверх/вниз в зависимости от значения в xData(idBegin, 1). Для поиска половинным делением для 200000 потребуется  до 17 операций поиска (правда, не учитывая, что VBA всё же интерпретатор)
Изменено: anvg - 29.03.2013 03:10:21
 
 
 
#17
29.03.2013 13:26:51
не знаю,сколько строк всего
можно видимо еще ускорить

прилагаю свой вариант
работает при при неточном задании параметра х
----------
Скрытый текст
 
 
 
#18
31.03.2013 02:40:47
Спасибо всем за советы.
Обязательно протестирую каждый вариант как будет больше свободного времени!
 
 
 
Страницы: 1
Читают тему
Наверх