Страницы: 1
RSS
Поменять значения ячеек местами согласно условию., Поменять значения ячеек местами согласно условию.
 

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

 
примерный набор данных есть?
Мы в Екселе не работаем, мы в нём живём!
 
Цитата
panix1111 написал:
примерный набор данных есть?
Да, конечно.
 
для одного столбца ф-ла
Код
=IF(ABS(A2)>ABS(B2),A2,B2)

Для второго - такая же только со знаком "меншье"
Стоп, там же макрос надо.
Подождите, счас
Изменено: panix1111 - 30.10.2017 20:58:34
Мы в Екселе не работаем, мы в нём живём!
 
Код
Sub Sasha()
Dim a As Range, b As Range, aa, bb
  Set a = Range("A2", Cells(Rows.Count, 1).End(xlUp))
  Set b = a.Offset(, 1)
  aa = a.Address(, , Application.ReferenceStyle)
  bb = b.Address(, , Application.ReferenceStyle)
  a.Offset(, 3) = Evaluate(Replace(Replace("IF(ABS(@)>ABS(#),@,#)", "@", aa), "#", bb))
  a.Offset(, 4) = Evaluate(Replace(Replace("IF(ABS(@)>ABS(#),#,@)", "@", aa), "#", bb))
End Sub
Изменено: Казанский - 30.10.2017 21:12:16
 
Вдруг кому-то пригодится. Формула массива:
=ИНДЕКС($A2:$B2;;ЕСЛИ(ABS($A2)>ABS($B2);НАИМЕНЬШИЙ({1;2};СТОЛБЕЦ()-3);НАИБОЛЬШИЙ({2;1};СТОЛБЕЦ()-3)))
Если в мире всё бессмысленно, — сказала Алиса, — что мешает выдумать какой-нибудь смысл? ©Льюис Кэрролл
 
Bema, для одной строки можно проще
Код
=ВЫБОР(ЕСЛИ(ABS(A2)>ABS(B2);{1;2};{2;1});A2;B2)
Только в макрос она плохо запихивается (чтобы на весь диапазон сразу).

PS Ан нет, работает (Excel 2010) !!!
Код
Sub Sasha1()
Dim n
  n = Cells(Rows.Count, 1).End(xlUp).Row
  [D2:E2].Resize(n - 1) = Evaluate(Application.ConvertFormula(Replace( _
    "CHOOSE(IF(ABS(A2:A#)>ABS(B2:B#),{1,2},{2,1}),A2:A#,B2:B#)", "#", n), _
    xlA1, Application.ReferenceStyle))
End Sub
Изменено: Казанский - 30.10.2017 21:41:47
 
Всем спасибо за отклик. Ваши решения работают, но я буду очень признателен, если макрос будет работать с любыми смежными столбцами и "на ходу" т.е. без вспомогательного столбца справа - по принципу "выделил область из двух столбцов-нажал кнопку-результат внутри" (внутри Selection)
 
Цитата
sasha_z_myor написал:
без вспомогательного столбца справа - по принципу "выделил область из двух столбцов-нажал кнопку-результат внутри"
Всё как просили
Код
Sub AbsSorter()
 Dim rng As Range
    Set rng = Application.InputBox("Укажите диапазон", "Ввод:", Type:=8)
  
rw = rng.Rows.Count
  For i = 1 To rw
    If Abs(rng.Cells(i, 1)) < Abs(rng.Cells(i, 2)) Then
    
        t = rng.Cells(i, 2)
        rng.Cells(i, 2) = rng.Cells(i, 1)
        rng.Cells(i, 1) = t
    
    End If
  
    Next

End Sub
Изменено: panix1111 - 30.10.2017 22:26:37
Мы в Екселе не работаем, мы в нём живём!
 
Цитата
sasha_z_myor написал:
по принципу "выделил область из двух столбцов-нажал кнопку-результат внутри" (внутри Selection)
Код
Sub Sasha2()
Dim a, b
  a = Selection.Columns(1).Address(, , Application.ReferenceStyle)
  b = Selection.Columns(2).Address(, , Application.ReferenceStyle)
  Selection.Value = Evaluate(Replace(Replace( _
    "CHOOSE(IF(ABS(@)>ABS(#),{1,2},{2,1}),@,#)", "@", a), "#", b))
End Sub
 
Казанский, panix1111,Спасибо огромное. Всё работает как надо  :idea:  
Страницы: 1
Наверх