Имя пользователя:
Пароль:
 

Название темы: Объекты в VBA (Excel)
Показать сообщение отдельно

Пользователь


Сообщения: 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

Название темы: Объекты в VBA (Excel)