Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Функция поиска максимального значения ячейки во всей книге - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Функция поиска максимального значения ячейки во всей книге (Макросы/Sub)
Функция поиска максимального значения ячейки во всей книге
t330 Дата: Пятница, 22.02.2019, 05:36 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 101
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Добрый день.
В книге Уокенбаха "Профессиональное программирование на ВБА" есть пример функции поиска максимального значения ячейки среди всех листов книги

[vba]
Код

Function MAXALLSHEETS(cell)
    Dim MaxVal As Double
    Dim Addr As String
    Dim Wksht As Object
    Application.Volatile
    Addr = cell.Range("A1").Address
    MaxVal = -9.9E+307
    For Each Wksht In cell.Parent.Parent.Worksheets
        If Wksht.Name = cell.Parent.Name And _
          Addr = Application.Caller.Address Then
        ' исключение циркулярной ссылки
        Else
            If IsNumeric(Wksht.Range(Addr)) Then
                If Wksht.Range(Addr) > MaxVal Then _
                  MaxVal = Wksht.Range(Addr).Value
            End If
        End If
    Next Wksht
    If MaxVal = -9.9E+307 Then MaxVal = 0
    MAXALLSHEETS = MaxVal
End Function

[/vba]

Я попытался вызвать эту функцию из Модуля Test

[vba]
Код


Sub test()

    Dim shttest As Worksheet
    Dim x As Variant
    Set shttest = ThisWorkbook.Worksheets("Лист3")
    
    x = shttest.Range("a1").Value
    
    Debug.Print MAXALLSHEETS(x)
    

End Sub

[/vba]

Но дебагер ругается на строку в коде функции:
[vba]
Код

    Addr = cell.Range("A1").Address
[/vba]

Поясните пожалуйста , что ему не нравится?

и

Поясните пожалуйста логику вот этой строки в коде функции:
Почему здесь после IF ... Then сразу идет Else ... После Then же должно идти что-то, что выполняется при соблюдении условия ...

[vba]
Код

        If Wksht.Name = cell.Parent.Name And _
          Addr = Application.Caller.Address Then
        ' исключение циркулярной ссылки
        Else
[/vba]

И зачем здесь MaxVal = -9.9E+307 ?

Спасибо.
К сообщению приложен файл: 0606415.xlsm(21.1 Kb)
 
Ответить
СообщениеДобрый день.
В книге Уокенбаха "Профессиональное программирование на ВБА" есть пример функции поиска максимального значения ячейки среди всех листов книги

[vba]
Код

Function MAXALLSHEETS(cell)
    Dim MaxVal As Double
    Dim Addr As String
    Dim Wksht As Object
    Application.Volatile
    Addr = cell.Range("A1").Address
    MaxVal = -9.9E+307
    For Each Wksht In cell.Parent.Parent.Worksheets
        If Wksht.Name = cell.Parent.Name And _
          Addr = Application.Caller.Address Then
        ' исключение циркулярной ссылки
        Else
            If IsNumeric(Wksht.Range(Addr)) Then
                If Wksht.Range(Addr) > MaxVal Then _
                  MaxVal = Wksht.Range(Addr).Value
            End If
        End If
    Next Wksht
    If MaxVal = -9.9E+307 Then MaxVal = 0
    MAXALLSHEETS = MaxVal
End Function

[/vba]

Я попытался вызвать эту функцию из Модуля Test

[vba]
Код


Sub test()

    Dim shttest As Worksheet
    Dim x As Variant
    Set shttest = ThisWorkbook.Worksheets("Лист3")
    
    x = shttest.Range("a1").Value
    
    Debug.Print MAXALLSHEETS(x)
    

End Sub

[/vba]

Но дебагер ругается на строку в коде функции:
[vba]
Код

    Addr = cell.Range("A1").Address
[/vba]

Поясните пожалуйста , что ему не нравится?

и

Поясните пожалуйста логику вот этой строки в коде функции:
Почему здесь после IF ... Then сразу идет Else ... После Then же должно идти что-то, что выполняется при соблюдении условия ...

[vba]
Код

        If Wksht.Name = cell.Parent.Name And _
          Addr = Application.Caller.Address Then
        ' исключение циркулярной ссылки
        Else
[/vba]

И зачем здесь MaxVal = -9.9E+307 ?

Спасибо.

Автор - t330
Дата добавления - 22.02.2019 в 05:36
krosav4ig Дата: Пятница, 22.02.2019, 07:22 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2164
Репутация: 905 ±
Замечаний: 0% ±

Excel 2007,2010,2013
t330, ну написано же в книге,
Цитата
function accepts a single-cell
т.е. в качестве агрумента принимает ячейку, а ячейка это объект Range, а вы пихаете ей что ни попадя. Вот и ругается, кричит Объект дай!!!
После Then же должно идти что-то
Вообще не обязательно, следующая процедура, вполне себе нормально работает, ничего, правда, не делает, но свою работу выполняет на все 100
[vba]
Код
Sub IDoNothing()
    If True Then
    Else
    End If
End Sub
[/vba]
зачем здесь MaxVal = -9.9E+307
Это просто очень большое отрицательное число, нужно, чтобы находилось максимальное число и среди отрицательных тоже, и во избежание лишнего цикла для поиска минимального числа

[vba]
Код
Function MAXALLSHEETS(cell)
    Dim MaxVal As Double
    Dim Addr As String, Addr1 As String
    Dim Wksht As Object
    Application.Volatile
    Addr = cell.Range("A1").Address
    MaxVal = -9.9E+307
    With Application
        If TypeName(.Caller) = "Range" Then Addr1 = .Caller.Address
    End With
    For Each Wksht In cell.Parent.Parent.Worksheets
        If Wksht.Name = cell.Parent.Name And Addr = Addr1 Then
        ' исключение циркулярной ссылки
        Else
            If IsNumeric(Wksht.Range(Addr)) Then
                If Wksht.Range(Addr) > MaxVal Then _
                  MaxVal = Wksht.Range(Addr).Value
            End If
        End If
    Next Wksht
    If MaxVal = -9.9E+307 Then MaxVal = 0
    MAXALLSHEETS = MaxVal
End Function
[/vba]

Application.Caller


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеt330, ну написано же в книге,
Цитата
function accepts a single-cell
т.е. в качестве агрумента принимает ячейку, а ячейка это объект Range, а вы пихаете ей что ни попадя. Вот и ругается, кричит Объект дай!!!
После Then же должно идти что-то
Вообще не обязательно, следующая процедура, вполне себе нормально работает, ничего, правда, не делает, но свою работу выполняет на все 100
[vba]
Код
Sub IDoNothing()
    If True Then
    Else
    End If
End Sub
[/vba]
зачем здесь MaxVal = -9.9E+307
Это просто очень большое отрицательное число, нужно, чтобы находилось максимальное число и среди отрицательных тоже, и во избежание лишнего цикла для поиска минимального числа

[vba]
Код
Function MAXALLSHEETS(cell)
    Dim MaxVal As Double
    Dim Addr As String, Addr1 As String
    Dim Wksht As Object
    Application.Volatile
    Addr = cell.Range("A1").Address
    MaxVal = -9.9E+307
    With Application
        If TypeName(.Caller) = "Range" Then Addr1 = .Caller.Address
    End With
    For Each Wksht In cell.Parent.Parent.Worksheets
        If Wksht.Name = cell.Parent.Name And Addr = Addr1 Then
        ' исключение циркулярной ссылки
        Else
            If IsNumeric(Wksht.Range(Addr)) Then
                If Wksht.Range(Addr) > MaxVal Then _
                  MaxVal = Wksht.Range(Addr).Value
            End If
        End If
    Next Wksht
    If MaxVal = -9.9E+307 Then MaxVal = 0
    MAXALLSHEETS = MaxVal
End Function
[/vba]

Application.Caller

Автор - krosav4ig
Дата добавления - 22.02.2019 в 07:22
t330 Дата: Пятница, 22.02.2019, 14:25 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 101
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
ну написано же в книге,


Я понимаю, что для профессионала тут все очевидно, но я только начал изучать ВБА с нуля и некоторые вщеи для меня не очевидны.
Сори, но Ваш ответ не прибавил ясности.
т.е. в качестве агрумента принимает ячейку, а ячейка это объект Range, а вы пихаете ей что ни попадя


В процедуре SUB Test() я и пихаю в функцию значение из ячейки А1 на листе3 , чтобы функция взяла это значение в качестве аргумента. Почему, когда я ввожу на самом Листе3 (а не в редакторе VBA) в ячейку A3 формулу "=MAXALLSHEETS(A1)" , то она же срабатывает и не ругается, хотя в функцию скормлено значение той же самой ячейки А1 Листа3, что указана в процедуре в редакторе VBA.

[vba]
Код

    Set shttest = ThisWorkbook.Worksheets("Лист3")
    
    x = shttest.Range("a1").Value
    
    Debug.Print MAXALLSHEETS(x)
[/vba]

Вообще не обязательно, следующая процедура, вполне себе нормально работает, ничего, правда, не делает, но свою работу выполняет на все 100


А что в итоге выполняет эта строка?
[vba]
Код

If Wksht.Name = cell.Parent.Name And _
        Addr = Application.Caller.Address Then
[/vba]
По-русски получается: Если "Имя листа" равно "Имени Листа аргумента функции" и переменная Addr равна адресу ячейки где применена функция MAXALLSHEETS , то .... То, что?

Application.Caller

За ссылку на справочник майкрософта спасибо. Прекрасно её знаю, с английским тоже прекрасно дружу, но поскольку, как я уже писал, изучаю с нуля, то этот сухой справочник реально мне пока мало помогает понять смысл некоторых вещей , особенно на английском. Иногда требуется более развернутое и подробное объяснение на русском. Если было бы все понятно в справочнике, то я бы сюда не писал.
 
Ответить
Сообщение
ну написано же в книге,


Я понимаю, что для профессионала тут все очевидно, но я только начал изучать ВБА с нуля и некоторые вщеи для меня не очевидны.
Сори, но Ваш ответ не прибавил ясности.
т.е. в качестве агрумента принимает ячейку, а ячейка это объект Range, а вы пихаете ей что ни попадя


В процедуре SUB Test() я и пихаю в функцию значение из ячейки А1 на листе3 , чтобы функция взяла это значение в качестве аргумента. Почему, когда я ввожу на самом Листе3 (а не в редакторе VBA) в ячейку A3 формулу "=MAXALLSHEETS(A1)" , то она же срабатывает и не ругается, хотя в функцию скормлено значение той же самой ячейки А1 Листа3, что указана в процедуре в редакторе VBA.

[vba]
Код

    Set shttest = ThisWorkbook.Worksheets("Лист3")
    
    x = shttest.Range("a1").Value
    
    Debug.Print MAXALLSHEETS(x)
[/vba]

Вообще не обязательно, следующая процедура, вполне себе нормально работает, ничего, правда, не делает, но свою работу выполняет на все 100


А что в итоге выполняет эта строка?
[vba]
Код

If Wksht.Name = cell.Parent.Name And _
        Addr = Application.Caller.Address Then
[/vba]
По-русски получается: Если "Имя листа" равно "Имени Листа аргумента функции" и переменная Addr равна адресу ячейки где применена функция MAXALLSHEETS , то .... То, что?

Application.Caller

За ссылку на справочник майкрософта спасибо. Прекрасно её знаю, с английским тоже прекрасно дружу, но поскольку, как я уже писал, изучаю с нуля, то этот сухой справочник реально мне пока мало помогает понять смысл некоторых вещей , особенно на английском. Иногда требуется более развернутое и подробное объяснение на русском. Если было бы все понятно в справочнике, то я бы сюда не писал.

Автор - t330
Дата добавления - 22.02.2019 в 14:25
_Boroda_ Дата: Пятница, 22.02.2019, 15:19 | Сообщение № 4
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15576
Репутация: 6077 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Давайте попробуем чуть иначе
cell - это не значение из ячейки, это САМА ячейка
То есть нужно вот так
[vba]
Код
Set x = shttest.Range("a1")
[/vba]
Если "Имя листа" равно "Имени Листа аргумента функции" и переменная Addr равна адресу ячейки где применена функция MAXALLSHEETS , то .... То, что?
То ничего, а вот если Else (не выполняется хотя бы одно из условий), то вот тогда проверяем на число и на максимум
А по поводу Caller - Вы откуда макрос запускаете? от этого зависит кто Келлером будет. В приведенном коде он (Келлер) нужен лишь для запуска функции с листа и именно в той ячейке, которая прописана в функции. То есть для записи в А1 (и только в ней, для остальных случаев Келлер не нужен)
Код
=MAXALLSHEETS(A1)

И не совсем ясна причина, по которой уважаемый Джон наш Уокенбах в цикле каждый раз его вычисляет, а не выносит в переменную
То есть примерно вот так переписать всё можно
[vba]
Код
Function MAXALLSHEETS(cell)
    Dim MaxVal As Double
    Dim Addr As String
    Dim Wksht As Object
    Application.Volatile
    Addr = cell.Range("A1").Address
    MaxVal = -9.9E+307
    On Error Resume Next
    ac_ = Application.Caller.Address
    For Each Wksht In cell.Parent.Parent.Worksheets
        If Wksht.Name = cell.Parent.Name And Addr = ac_ Then
            ' то ничего не делаем
        Else ' иначе
            If IsNumeric(Wksht.Range(Addr)) Then
                If Wksht.Range(Addr) > MaxVal Then _
                  MaxVal = Wksht.Range(Addr).Value
            End If
        End If
    Next Wksht
    If MaxVal = -9.9E+307 Then MaxVal = 0
    MAXALLSHEETS = MaxVal
End Function
Sub test2()
    Dim shttest As Worksheet
    Dim x As Variant
    Set shttest = ThisWorkbook.Worksheets("Лист3")
    Set x = shttest.Range("a1")
    Debug.Print MAXALLSHEETS(x)
End Sub
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеДавайте попробуем чуть иначе
cell - это не значение из ячейки, это САМА ячейка
То есть нужно вот так
[vba]
Код
Set x = shttest.Range("a1")
[/vba]
Если "Имя листа" равно "Имени Листа аргумента функции" и переменная Addr равна адресу ячейки где применена функция MAXALLSHEETS , то .... То, что?
То ничего, а вот если Else (не выполняется хотя бы одно из условий), то вот тогда проверяем на число и на максимум
А по поводу Caller - Вы откуда макрос запускаете? от этого зависит кто Келлером будет. В приведенном коде он (Келлер) нужен лишь для запуска функции с листа и именно в той ячейке, которая прописана в функции. То есть для записи в А1 (и только в ней, для остальных случаев Келлер не нужен)
Код
=MAXALLSHEETS(A1)

И не совсем ясна причина, по которой уважаемый Джон наш Уокенбах в цикле каждый раз его вычисляет, а не выносит в переменную
То есть примерно вот так переписать всё можно
[vba]
Код
Function MAXALLSHEETS(cell)
    Dim MaxVal As Double
    Dim Addr As String
    Dim Wksht As Object
    Application.Volatile
    Addr = cell.Range("A1").Address
    MaxVal = -9.9E+307
    On Error Resume Next
    ac_ = Application.Caller.Address
    For Each Wksht In cell.Parent.Parent.Worksheets
        If Wksht.Name = cell.Parent.Name And Addr = ac_ Then
            ' то ничего не делаем
        Else ' иначе
            If IsNumeric(Wksht.Range(Addr)) Then
                If Wksht.Range(Addr) > MaxVal Then _
                  MaxVal = Wksht.Range(Addr).Value
            End If
        End If
    Next Wksht
    If MaxVal = -9.9E+307 Then MaxVal = 0
    MAXALLSHEETS = MaxVal
End Function
Sub test2()
    Dim shttest As Worksheet
    Dim x As Variant
    Set shttest = ThisWorkbook.Worksheets("Лист3")
    Set x = shttest.Range("a1")
    Debug.Print MAXALLSHEETS(x)
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 22.02.2019 в 15:19
sboy Дата: Пятница, 22.02.2019, 16:18 | Сообщение № 5
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 722 ±
Замечаний: 0% ±

Excel 2010
я и пихаю в функцию значение из ячейки А1

надо не значение, а саму ячейку, как объект
[vba]
Код
Debug.Print MAXALLSHEETS(shttest.Range("a1"))
[/vba]
То, что?

Конец если


Яндекс: 410016850021169
 
Ответить
Сообщение
я и пихаю в функцию значение из ячейки А1

надо не значение, а саму ячейку, как объект
[vba]
Код
Debug.Print MAXALLSHEETS(shttest.Range("a1"))
[/vba]
То, что?

Конец если

Автор - sboy
Дата добавления - 22.02.2019 в 16:18
t330 Дата: Пятница, 22.02.2019, 17:21 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 101
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
То есть примерно вот так переписать всё можно

Вот этот Ваш код работает.

А если в старом Sub Test сделать как Вы сказали :
То есть нужно вот так
[vba]
Код
Set x = shttest.Range("a1")
[/vba]
, то все равно дебагер ругается и пишет нет объекта на строке №10

[vba]
Код

Option Explicit

Function MAXALLSHEETS(cell)
    Dim MaxVal As Double
    Dim Addr As String
    Dim Wksht As Object
    Application.Volatile
    Addr = cell.Range("A1").Address
    MaxVal = -9.9E+307
    For Each Wksht In cell.Parent.Parent.Worksheets
10        If Wksht.Name = cell.Parent.Name And _
        Addr = Application.Caller.Address Then
        ' исключение циркулярной ссылки
        Else
            If IsNumeric(Wksht.Range(Addr)) Then
                If Wksht.Range(Addr) > MaxVal Then _
                MaxVal = Wksht.Range(Addr).Value
            End If
        End If
    Next Wksht
    If MaxVal = -9.9E+307 Then MaxVal = 0
    MAXALLSHEETS = MaxVal
End Function
Sub test()

    Dim shttest As Worksheet
    Dim x As Variant
    Set shttest = ThisWorkbook.Worksheets("Лист3")

 Set x = shttest.Range("a1")

    Debug.Print MAXALLSHEETS(x)

End Sub

[/vba]


Сообщение отредактировал t330 - Суббота, 23.02.2019, 03:06
 
Ответить
Сообщение
То есть примерно вот так переписать всё можно

Вот этот Ваш код работает.

А если в старом Sub Test сделать как Вы сказали :
То есть нужно вот так
[vba]
Код
Set x = shttest.Range("a1")
[/vba]
, то все равно дебагер ругается и пишет нет объекта на строке №10

[vba]
Код

Option Explicit

Function MAXALLSHEETS(cell)
    Dim MaxVal As Double
    Dim Addr As String
    Dim Wksht As Object
    Application.Volatile
    Addr = cell.Range("A1").Address
    MaxVal = -9.9E+307
    For Each Wksht In cell.Parent.Parent.Worksheets
10        If Wksht.Name = cell.Parent.Name And _
        Addr = Application.Caller.Address Then
        ' исключение циркулярной ссылки
        Else
            If IsNumeric(Wksht.Range(Addr)) Then
                If Wksht.Range(Addr) > MaxVal Then _
                MaxVal = Wksht.Range(Addr).Value
            End If
        End If
    Next Wksht
    If MaxVal = -9.9E+307 Then MaxVal = 0
    MAXALLSHEETS = MaxVal
End Function
Sub test()

    Dim shttest As Worksheet
    Dim x As Variant
    Set shttest = ThisWorkbook.Worksheets("Лист3")

 Set x = shttest.Range("a1")

    Debug.Print MAXALLSHEETS(x)

End Sub

[/vba]

Автор - t330
Дата добавления - 22.02.2019 в 17:21
krosav4ig Дата: Пятница, 22.02.2019, 18:23 | Сообщение № 7
Группа: Друзья
Ранг: Старожил
Сообщений: 2164
Репутация: 905 ±
Замечаний: 0% ±

Excel 2007,2010,2013
t330, ну дык та же самая ошибка (424, Дай объект)
Растет отсюда
У вас функция выполняется из обычного макроса, и, в соответствии с таблицей по ссылке, Application.Caller принимает значение #REF! и ,следовательно, не является объектом и не может наследовать у класса Range свойство Address
Мыж с Александром ( _Boroda_) не просто так писали
With Application
        If TypeName(.Caller) = "Range" Then Addr1 = .Caller.Address
    End With
    For Each Wksht In cell.Parent.Parent.Worksheets
        If Wksht.Name = cell.Parent.Name And Addr = Addr1 Then
On Error Resume Next
    ac_ = Application.Caller.Address
    For Each Wksht In cell.Parent.Parent.Worksheets
        If Wksht.Name = cell.Parent.Name And Addr = ac_ Then


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеt330, ну дык та же самая ошибка (424, Дай объект)
Растет отсюда
У вас функция выполняется из обычного макроса, и, в соответствии с таблицей по ссылке, Application.Caller принимает значение #REF! и ,следовательно, не является объектом и не может наследовать у класса Range свойство Address
Мыж с Александром ( _Boroda_) не просто так писали
With Application
        If TypeName(.Caller) = "Range" Then Addr1 = .Caller.Address
    End With
    For Each Wksht In cell.Parent.Parent.Worksheets
        If Wksht.Name = cell.Parent.Name And Addr = Addr1 Then
On Error Resume Next
    ac_ = Application.Caller.Address
    For Each Wksht In cell.Parent.Parent.Worksheets
        If Wksht.Name = cell.Parent.Name And Addr = ac_ Then

Автор - krosav4ig
Дата добавления - 22.02.2019 в 18:23
t330 Дата: Суббота, 23.02.2019, 03:36 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 101
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Всем, спасибо.
Стало гораздо понятнее!
 
Ответить
СообщениеВсем, спасибо.
Стало гораздо понятнее!

Автор - t330
Дата добавления - 23.02.2019 в 03:36
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Функция поиска максимального значения ячейки во всей книге (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2019 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!