Объекты в VBA (Excel) - Компьютерный форум OSzone.net

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Программирование и базы данных (http://forum.oszone.net/forumdisplay.php?f=21)

- - Объекты в VBA (Excel) (http://forum.oszone.net/showthread.php?t=200137)

Объекты в VBA (Excel)

Разработать подпрограмму нахождения в выделенном диапазоне рабочей таблицы максимального и минимального значения по строкам и по столбцам. Элементы массива задать самостоятельно через функцию Inputbox.

Ввод элементов массива получился, но как найти остальное....

Код:

Public Sub r()

Dim stl As Integer

Dim str As Integer

Dim i As Integer

Dim j As Integer

stl = InputBox("Введите количество столбцов")

str = InputBox("Введите количество строк")

For i = 1 To stl

For j = 1 To str

Sheets("Лист1").Cells(i, j) = InputBox("Введите" & j & "элемент" & i & "строки")

Next j

Next i

End Sub

Условие непонятное

Цитата:

Элементы массива задать самостоятельно через функцию Inputbox.

это значит надо самому заполнить все ячейки по строкам и столбцам.

Цитата:

нахождения в выделенном диапазоне рабочей таблицы максимального и минимального значения по строкам и по столбцам.

а это предусматривает поиск в уже заполненной таблице.

Если таблицу заполняешь сам значит заранее уже знаешь какое значение будет минимальным а какое максимальным

Цитата:

это значит надо самому заполнить все ячейки по строкам и столбцам.

Именно так нужно. Это уже у меня сделано в выше поставленной программе.

Далее, к примеру, из введённого массива 4х4 выделяется следующий диапазон:

1 2 3 4
5 6 7 8
2 6 9 4
0 3 5 1

И из этого находится минимальное и максимальное значение.

Цитата:

Цитата 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

Немного не то...
1) Нужно с клавиатуры ввести элементы массива, задав количество строк и столбцов.
2) Далее, например, из введённого массива выделяем смостоятельно произвольный диапазон и для данного примера в соответствующие ячейки выводится ответ:
2 3 4 -5

мах 4 min 2

8 1 -5 -8

мах 10 min -5

0 5 4 7

мах 5 min 0

мах 8 мах 10 мах 4
min 0 min1 min-5

как можно разбить код, чтобы выделение диапазона ячеек происходило после ввода массива?

Код:

Sub m_1()

Dim myArray As Variant

Dim i As Long

Dim j As Long

Dim Max As Variant

Dim Min As Variant

Dim stl As Integer

Dim str As Integer

 stl = InputBox("Введите количество столбцов")

 str = InputBox("Введите количество строк")

 For i = 1 To stl

  For j = 1 To str

   Sheets("Лист1").Cells(i, j) = InputBox("Введите" & j & "элемент" & i & "строки")

 Next j

 Next i

myArray = Selection

For i = 1 To UBound(myArray, 1)

    Max = myArray(i, 1)

    Min = myArray(i, 1)

    For j = 1 To UBound(myArray, 2)

        If myArray(i, j) > Max Then

            Max = myArray(i, j)

        ElseIf myArray(i, j) < Min Then

            Min = myArray(i, j)

        End If

    Next j

    Cells(i, 10).Value = "max" & " " & Max & " " & "min" & " " & Min

Next i

End Sub

zena, пару вопросов. В VBA не силен, поэтому спрашиваю.
Что это за строка? myArray = Selection
MyArray определен как Variant. А что такое Selection? Если тут ошибки нет, то идем дальше.
Что такое Ubound ? "For j = 1 To UBound(myArray, 2)"
Пока смутное и неясное подозрение на логику работы цикла поиска. Вроде все правильно, но что-то смущает.

lxa85, +1

Цитата:

Цитата zena

Немного не то... »

в чем собственно не то ? как спросили - так и ответил, добавьте в главную функцию перед её началом, то что Вы сами писали про заполнение таблицы и все будет ОК

Цитата:

Цитата lxa85

Что такое Ubound ? »

Ubound - функция возвращающяя размерность массива, в данном слечае третье изменение массива - что само по себе уже неверно

Цитата:

Цитата lxa85

Что это за строка? myArray = Selection »

аналогичный вопрос, zena, зачем Вы в переменную myArray - записывает Объект Selection?

Подскажите пожалуйста как в Exel ввести функцию Xmin<=X<=Xmax

в справке excel есть пример

Код:

=ЕСЛИ(И(1<=A3; A3<=100); A3; "Значение вне интервала.")