Передать переменные в другой макрос, как это реализовать ?

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Передать переменные в другой макрос, как это реализовать ? (Макросы/Sub)

antycapral

Дата: Понедельник, 04.04.2016, 15:18 | Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 62

Репутация: 5 ±

Замечаний: 0% ±

Excel 2016

День добрый!
Написал небольшую раскраску, на основе готового макроса из РуНета:

[vba]

Код

    Dim ra As Range, cell As Range, res, txt$, v, pos&
    On Error Resume Next: Err.Clear

    ' Линия БОПП
    Range("O9:V9") = Range("B36:I36").Value ' Линия БОПП
    Range("O9:V9").Font.Color = 0

    Set ra = Range("O9:V9")     ' диапазон для поиска
    ' минимальный отход
    res = Application.Round(Application.WorksheetFunction.Min(Range("B30:I30")), 0)
    Цвет = -11489280 ' зеленный
    ' процедура раскраски текста
            txt$ = Trim(res)
            For Each cell In ra.Cells    ' перебираем все ячейки
                pos = 1
                If cell.Text Like "*" & txt & "*" Then
                    arr = Split(cell.Text, txt, , vbTextCompare)   ' разбивает текст ячейки на части
                    If UBound(arr) > 0 Then    ' если подстрока найдена
                        For Each v In arr    ' перебираем все вхождения
                            pos = pos + Len(v)    ' начальная позиция
                            With cell.Characters(pos, Len(txt))
                    .Font.Color = Цвет    ' выделяем цветом
                            End With
                            pos = pos + Len(txt)
                        Next v
                    End If
                End If
            Next cell

        ' максимальный отход
        res = Application.Round(Application.WorksheetFunction.Max(Range("B30:I30")), 0)
        Цвет = -16777024 ' красный

       ' процедура раскраски текста
            txt$ = Trim(res)
            For Each cell In ra.Cells    ' перебираем все ячейки
                pos = 1
                If cell.Text Like "*" & txt & "*" Then
                    arr = Split(cell.Text, txt, , vbTextCompare)   ' разбивает текст ячейки на части
                    If UBound(arr) > 0 Then    ' если подстрока найдена
                        For Each v In arr    ' перебираем все вхождения
                            pos = pos + Len(v)    ' начальная позиция
                            With cell.Characters(pos, Len(txt))
                    .Font.Color = Цвет    ' выделяем цветом
                            End With
                            pos = pos + Len(txt)
                        Next v
                    End If
                End If
            Next cell

[/vba]

Как мне выделить в отдельное место кода эту процедуру раскраски, чтоб не плодить много букв кода ?
То есть определил в диапазоне макс значение, вызвал процедуру, раскрасил, далее ищем минимальное значение и снова раскраска текста ?

Вот примерный скелет кода, но переменные не передает (((
[vba]

Код

    ' Линия БОПП
    Range("O9:V9") = Range("B36:I36").Value ' Линия БОПП
    Range("O9:V9").Font.Color = 0

    Set ra = Range("O9:V9")     ' диапазон для поиска
    ' минимальный отход
    res = Application.Round(Application.WorksheetFunction.Min(Range("B30:I30")), 0)
    Цвет = -11489280 ' зеленный

  Call процедура_раскраски_текста

    res = Application.Round(Application.WorksheetFunction.Max(Range("B30:I30")), 0)
    Цвет = -16777024 ' красный

  Call процедура_раскраски_текста

' и так далее ....

[/vba]

День добрый!
Написал небольшую раскраску, на основе готового макроса из РуНета:

[vba]

Код

[/vba]antycapral

Сообщение отредактировал antycapral - Понедельник, 04.04.2016, 15:19

Ответить

СообщениеДень добрый!
Написал небольшую раскраску, на основе готового макроса из РуНета:

[vba]

Код

[/vba]

Автор - antycapral
Дата добавления - 04.04.2016 в 15:18

Udik

Дата: Понедельник, 04.04.2016, 16:00 | Сообщение № 2

Группа: Друзья

Ранг: Старожил

Сообщений: 1588

Репутация: 192 ±

Замечаний: 0% ±

Excel 2016 х 64

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

вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com

Сообщение отредактировал Udik - Понедельник, 04.04.2016, 16:05

Ответить

Roman777

Дата: Понедельник, 04.04.2016, 16:09 | Сообщение № 3

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

Передавать нужно типа такого:
[vba]

Код

Sub процедура_раскраски_текста(res, ra As Range, Цвет)
Dim cell As Range
Dim txt$
Dim v, pos&
    On Error Resume Next: Err.Clear
    ' процедура раскраски текста
            txt$ = Trim(res)
            For Each cell In ra.Cells    ' перебираем все ячейки
                pos = 1
                If cell.Text Like "*" & txt & "*" Then
                    arr = Split(cell.Text, txt, , vbTextCompare)   ' разбивает текст ячейки на части
                    If UBound(arr) > 0 Then    ' если подстрока найдена
                        For Each v In arr    ' перебираем все вхождения
                            pos = pos + Len(v)    ' начальная позиция
                            With cell.Characters(pos, Len(txt))
                    .Font.Color = Цвет    ' выделяем цветом
                            End With
                            pos = pos + Len(txt)
                        Next v
                    End If
                End If
            Next cell
End Sub

[/vba]
[vba]

Код

Sub macr()
Dim ra As Range, res
    ' Линия БОПП
    Range("O9:V9") = Range("B36:I36").Value ' Линия БОПП
    Range("O9:V9").Font.Color = 0

    Set ra = Range("O9:V9")     ' диапазон для поиска
    ' минимальный отход
    res = Application.Round(Application.WorksheetFunction.Min(Range("B30:I30")), 0)
    Цвет = -11489280 ' зеленный

Call процедура_раскраски_текста(res, ra, Цвет)

    res = Application.Round(Application.WorksheetFunction.Max(Range("B30:I30")), 0)
    Цвет = -16777024 ' красный

Call процедура_раскраски_текста(res, ra, Цвет)

' и так далее ....

End Sub

[/vba]

Передавать нужно типа такого:
[vba]

Код