Поменять местами максимальный элемент массива и минимальный элемент части массива, расположенной после максимального. VBA

Question

возникла проблема при решении данной задачи. Почему-то неверно определяется максимальный элемент, который нужно заменить. Вместо этого заменяется минимальный элемент. Хотя походу где-то еще накосячил. Код:

Sub n28()
    Dim i As Double, k As Double, j As Double
    Dim max As Double, min As Double
    Dim A(1 To 10) As Double

    For i = 1 To 8
        A(i) = Cells(i, 1)
    Next
    max = A(1)
    For i = 2 To 8
        If A(i) > max Then
            k = i
            max = A(i)
        End If
    Next
    min = A(k + 1)
    For i = k + 1 To 8 Step 1
        If A(i) < min Then
            j = i
            min = A(i)
        End If
    Next
    Cells(j + 1, 2) = min
    Cells(k + 1, 2) = max
End Sub

Заранее спасибо.

UPD: Так, разобрался сам. вот решение, может кому понадобиться...

Sub n28()
    Dim i As Double, k As Double, j As Double
    Dim max As Double, min As Double
    Dim A(1 To 10) As Double
    For i = 1 To 8
        A(i) = Cells(i, 1)  
    Next
    max = A(1)
    For i = 2 To 8
        If A(i) > max Then
            k = i
            max = A(i)
        End If
    Next
    min = A(k)
    For i = k + 1 To 8 Step 1
        If A(i) < min Then
            j = i
            min = A(i)
        End If
    Next
    Cells(j, 2) = max
    Cells(k, 2) = min
End Sub

Answer 1

По Вашем коду значения не меняются местами, а в соседний столбец выводятся максимальное возле минимального и наоборот. Если нужна замена в исходном диапазоне, указвывать первый столбец в ссылках на ячейки.

Где-то так...

Sub n28()
    Dim A()
    Dim dMax As Double, dMin As Double
    Dim i As Long, n As Long, k As Long

    A = Range("A1:A8").Value
    dMin = 99999 ' больше максимального значения в диапазоне'
    
    For i = 2 To 8
        If A(i, 1) > dMax Then k = i: dMax = A(i, 1)
        If A(i, 1) < dMin Then n = i: dMin = A(i, 1)
    Next i
    
    Cells(n, 2).Value = dMax
    Cells(k, 2).Value = dMin
End Sub

В начале процедуры максимальное для dMin = 99999 - или взять намного больше возможного максимального, или вычислить с помощью функции листа:

dMax = Application.Max(Range("A1:A8"))
dMin = dMax

Кстати, и минимальное можно так же определить (Application.Min), а в цикле находить только их положение в диапазоне

P.S. Пропустил условие "минимальный элемент... после максимального". Тогда так (заодно вариант без использования двух переменных):

Sub n28_2()
    Dim A()
    Dim i As Long, n As Long, k As Long
    
    A = Range("A1:A8").Value
    k = 1
    
    For i = 2 To 8
        If A(i, 1) > A(k, 1) Then k = i
    Next i
    
    n = k
    
    For i = k To 8
        If A(i, 1) < A(n, 1) Then n = i
    Next i

    Cells(n, 2) = A(k, 1)
    Cells(k, 2) = A(n, 1)
End Sub

БЛОГ НА HUSL

Поменять местами максимальный элемент массива и минимальный элемент части массива, расположенной после максимального. VBA

Ответы (1 шт):