Выделите на листе прямоугольную область ячеек с левым верхним углов в A1 и запустите программу, которая в каждой строке выделенной области обменяет местами содержимое ячеек с минимальным и максимальным значениями.
Sub abc() a = Selection.Value For i = 1 To UBound(a, 1) aMin = a(i, 1): aMax = aMin jMin = 1: jMax = 1 For j = 2 To UBound(a, 2) If aMin > a(i, j) Then aMin = a(i, j): jMin = j End If If aMax < a(i, j) Then aMax = a(i, j): jMax = j End If Next j Cells(i, jMin).Value = aMax Cells(i, jMax).Value = aMin Next i End Sub