Пользователь
Сообщения: 120
Благодарности: 22
|
Профиль
| Цитировать
Цитата zena:
в выделенном диапазоне рабочей таблицы максимального и минимального значения по строкам и по столбцам »
|
и
Цитата zena:
выделяется следующий диапазон:
1 2 3 4
5 6 7 8
2 6 9 4
0 3 5 1
И из этого находится минимальное и максимальное значение »
|
из чего именно нужны Мин и Макс?
как в первом посте написано (мин и макс для каждой строки и каждого столбца)?
или как в третьем посте (мин и макс среди всех значений входящих в выделенный диапазон)?
если как в третьем тогда вот так (стоит учесть что макс и мин значения считаются только первые из найденных - если несколько одинаковых значений):
ВСПОМОГАТЕЛЬНЫЕ ФУНКЦИИ
Код: 
Private Function fnNum2ColName(ByVal i As Long) As String
Dim k As Integer
If i < 27 Then
fnNum2ColName = IIf(i <= 0, "", Chr(i + 64))
Else
k = ((i - 1) \ 26)
fnNum2ColName = fnNum2ColName(k) & fnNum2ColName(i - 26 * k)
End If
End Function
Private Function fnGetColNameFromCellName(ByVal inp As String) As String
Dim res As String
Dim i As Long
res = ""
inp = UCase$(inp)
For i = 1 To Len(inp)
If 65 <= Asc(Mid(inp, i, 1)) And Asc(Mid(inp, i, 1)) <= 90 Then
res = res & Mid(inp, i, 1)
Else
'Как только нашли первую не букву - завершаем
Exit For
End If
Next i
fnGetColNameFromCellName = res
End Function
Private Function fnGetRowNumberFromCellName(ByVal inp As String) As Long
Dim res As String
Dim i As Long
res = ""
inp = UCase$(inp)
For i = 1 To Len(inp)
If 65 <= Asc(Mid(inp, i, 1)) And Asc(Mid(inp, i, 1)) <= 90 Then
'не обращаем внимания на буквы
ElseIf 48 <= Asc(Mid(inp, i, 1)) <= 57 Then
res = res & Mid(inp, i, 1)
Else
'Если недопустимый символ - выходим
Exit For
End If
Next i
fnGetRowNumberFromCellName = Val(res)
End Function
Private Function fnGetColNumberByColName(ByVal inp As String) As Long
Dim k As Integer
inp = UCase$(inp)
If Len(inp) <= 2 Then
If Len(inp) = 1 Then
fnGetColNumberByColName = (Asc(inp) - 64)
ElseIf Len(inp) = 2 Then
fnGetColNumberByColName = (Asc(Mid(inp, 1, 1)) - 64) * 26 + (Asc(Mid(inp, 2, 1)) - 64)
Else 'Если нет входных данных
fnGetColNumberByColName = 1
End If
Else 'Если число букв больше 2-ух (нетребовалось пока для большего)
fnGetColNumberByColName = 26 ^ 3
End If
End Function
СОБСТВЕННО ИНТЕРЕСУЮЩАЯ ВАС ФУНКЦИЯ
Код: 
Sub Main()
Dim addr() As String
Dim minRow As Long, maxRow As Long
Dim minCol As Long, maxCol As Long
Dim minColNam As String, maxColNam As String
Dim rn As Long, cn As Long
Dim minValue As Double, maxValue As Double
Dim minCellName As String, maxCellName As String
addr = Split(Selection.Address(ReferenceStyle:=xlA1, ColumnAbsolute:=False, RowAbsolute:=False), ":")
If UBound(addr) = 0 Then
ReDim Preserve addr(1)
addr(1) = addr(0)
End If
minColNam = fnGetColNameFromCellName(addr(0))
maxColNam = fnGetColNameFromCellName(addr(UBound(addr)))
'Определяем границы поиска мин и макс значения строки
minRow = fnGetRowNumberFromCellName(addr(0))
maxRow = fnGetRowNumberFromCellName(addr(UBound(addr)))
'Определяем границы поиска мин и макс значения столбца
minCol = fnGetColNumberByColName(minColNam)
maxCol = fnGetColNumberByColName(maxColNam)
'Задаем начальное значение мин и макс = первой выбранной ячейке
minCellName = minColNam & minRow
minValue = CDbl(Range(minCellName).Value & "")
maxCellName = minCellName
maxValue = CDbl(Range(maxCellName).Value & "")
'Ищем мин и макс значения одновременно
For rn = minRow To maxRow
For cn = minCol To maxCol
If CDbl(Range(fnNum2ColName(cn) & rn).Value & "") > maxValue Then
maxCellName = fnNum2ColName(cn) & rn
maxValue = CDbl(Range(maxCellName).Value & "")
End If
If CDbl(Range(fnNum2ColName(cn) & rn).Value & "") < minValue Then
minCellName = fnNum2ColName(cn) & rn
minValue = CDbl(Range(minCellName).Value & "")
End If
Next cn
Next rn
'Выводим результат в Immediate и MsgBox
Debug.Print "Минимальное значение находится в ячейке: '" & minCellName & "' и равно: '" & Format$(minValue, "# ##0.00") & "'"
Debug.Print "Максимальное значение находится в ячейке: '" & maxCellName & "' и равно: '" & Format$(maxValue, "# ##0.00") & "'"
MsgBox "Минимальное значение находится в ячейке: '" & minCellName & "' и равно: '" & Format$(minValue, "# ##0.00") & "'" & vbNewLine & "Максимальное значение находится в ячейке: '" & maxCellName & "' и равно: '" & Format$(maxValue, "# ##0.00") & "'", vbInformation, "Результаты поиска минимума и максимума среди выбранных ячеек"
End Sub
|
Последний раз редактировалось KnRSU, 22-02-2011 в 11:39.
Отправлено: 11:08, 22-02-2011
| #4
|