Просьба помочь модифицировать макрос Выделить_минимум таким образом, чтобы поиск минимума в строке происходил при выборе несвязанных диапазонов, т.е. что бы запустив макрос с указанием диапазона =$E$2:$E$4;$G$2:$G$4;$I$2:$I$4 результат был аналогичен закраске в диапазоне А2:С4. Столбцов в диапазоне может быть больше, чем 3, столбцы в диапазоне всегда не смежные, т.е. между двумя столбцами есть хотя бы один столбец. В данный момент не могу понять, как обращаться к элементам строки разных диапазонов, чтобы их можно было сравнивать и искать по ним минимум.
Так же буду благодарен, если отправите ссылку на решение подобных задач на форуме, похожих задач найти не смог.
Код по поиску минимума взят частично здесь и здесь.
Option Explicit
'====================================================================================================
Sub SelectMin()
Dim rng As Range, ar As Range, gr As Range
Dim arr, iMin#, t!, r&, c&, n&, AC&, iColor&
t = Timer ' засекаем время
iColor = vbGreen ' переменная для цвета заливки
Set rng = Intersect(Selection, ActiveSheet.UsedRange) ' пересечение выделенного диапазона и рабочей области листа
Application.ScreenUpdating = False
AC = Application.Calculation: Application.Calculation = xlCalculationManual
For Each ar In rng.Areas ' цикл по ОБЛАСТЯМ (то, что вам нужно было)
arr = ar.Value
If IsArray(arr) Then
For r = 1 To UBound(arr, 1)
iMin = 1E+30 ' заведомо огромное число, которого не будет в строке
Set gr = Nothing ' очищаем группу
For c = 1 To UBound(arr, 2)
If Len(arr(r, c)) And IsNumeric(arr(r, c)) Then
If arr(r, c) = iMin Then
Set gr = Union(gr, ar.Cells(r, c))
ElseIf arr(r, c) < iMin Then
iMin = arr(r, c)
Set gr = ar.Cells(r, c)
End If
End If
Next c
If Not gr Is Nothing Then ' если группа была создана, то …
n = n + gr.Cells.Count ' считем закрашенные
gr.Interior.Color = iColor ' закрашиваем
End If
Next r
End If
Next ar
Application.Calculation = AC
Application.ScreenUpdating = True
MsgBox "Успешно закрашено ячеек: " & Format(n, "# ### ##0"), vbInformation, Format(Timer - t, "0.00 сек")
End Sub
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous, спасибо! Можете, пожалуйста, подсказать, на что обратить внимание и модифицировать код, чтобы диапазон выделялся не целиком, а избирательно, т.е. в пустых столбцах есть значения, но для расчета минимального они не требуется.
Alex213: в пустых столбцах есть значения, но для расчета минимального они не требуется
делайте цикл не сплошной по всем столбцам области For c=1 To UBound(arr,2), а по списку столбцов For Each x In Array(2,4,6) или по всем, но с проверкой If c<>1 And c<>3 Then, например
Пока что ваша хотелка абстрактна и не по теме. Создавайте новую тему с примером и описанием
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄