Решены обе проблемы: перебрать все листы и выбрать диапазон / столбец.Я создал 2 функции (функции можно найти ниже), одну для минимума, а другую для максимума.Вам нужно только выбрать диапазон, как показано на рисунке ниже.Обе функции работают, даже если у вас есть пробелы или текст в выбранном диапазоне между листами, но если у вас есть ошибки, они не работают.
Чтобы иметь возможность использовать эти функции.Вам необходимо скопировать исходный код функций (см. Ниже) в модуль.Функции будут доступны только в рабочей книге, в которую вы скопировали эти функции.
Если вы хотите, чтобы функции были доступны для любой открытой вами рабочей книги.Вам нужно сохранить книгу, содержащую функцию, как надстройку, а затем активировать надстройку. Это действительно простой шаг Нажмите здесь, чтобы узнать, как выполнить надстройку
Обратите внимание: если вы набираете функции, скажем, в «sheet1», то вы переходите на другой лист, скажем, «sheet2», и меняете числа, которые функции не будут вычислять автоматически.Вам нужно перейти на панель формул и нажать клавишу ввода.Если номер, который вы изменяете, находится на том же листе, что и лист, вы набрали функции.Он обновляется автоматически
Функция минимальной ширины листов
Public Function Minimum_Across_Sheets(rngSelection As Range) As Double
Dim dMinimum_Value As Double
Dim bFirst_Value_Obtained As Boolean
Dim rng As Range
Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
For Each rng In rngSelection
If IsNumeric(wks.Cells(rng.Row, rng.Column)) And Len(wks.Cells(rng.Row, rng.Column)) > 0 Then
If Not bFirst_Value_Obtained Then
dMinimum_Value = wks.Cells(rng.Row, rng.Column)
bFirst_Value_Obtained = True
End If
If wks.Cells(rng.Row, rng.Column) < dMinimum_Value Then
dMinimum_Value = wks.Cells(rng.Row, rng.Column)
End If
End If
Next rng
Next wks
Minimum_Across_Sheets = dMinimum_Value
End Function
Функция максимальной ширины листов
Public Function Maximum_Across_Sheets(rngSelection As Range) As Double
Dim dMaximum_Value As Double
Dim bFirst_Value_Obtained As Boolean
Dim rng As Range
Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
For Each rng In rngSelection
If IsNumeric(wks.Cells(rng.Row, rng.Column)) And Len(wks.Cells(rng.Row, rng.Column)) > 0 Then
If Not bFirst_Value_Obtained Then
dMaximum_Value = wks.Cells(rng.Row, rng.Column)
bFirst_Value_Obtained = True
End If
If wks.Cells(rng.Row, rng.Column) > dMaximum_Value Then
dMaximum_Value = wks.Cells(rng.Row, rng.Column)
End If
End If
Next rng
Next wks
Maximum_Across_Sheets = dMaximum_Value
End Function
Надеюсь, что это полезно для вас.