как передать аргумент?

[Sergey112233]

Уважаемые форумчане.
Программа находит в столбце А:А несколько последовательно идущих одинаковых записей код, а в столбце С:С , соответственно, записывает текущую дату.

Надо вот эту часть кода:

        m = 0
        Do
        If poz <> poz.Offset(m, 0) Then Exit Do
                    poz.Offset(m, 2) = Date + k
                    m = m - 1
       
        Loop
            poz.Offset(0, 2).Select

сделать отдельной программой или функцией, чтобы вызывать ее необходимое количество раз.
Подскажите пожалуйста, как передать в функцию в качестве аргумента poz.Offset(m, 0)?

Например, вот так не получается
       
Public Function prov(poz1)
        m = 0
        Do
        If poz1 <> poz1.Offset(m, 0) Then Exit Do
                    poz1.Offset(m, 2) = Date + k
                    m = m - 1
       
        Loop
        End Function

[GWolf]

Добрый вечер!
Может быть объясните природу сией задачи? Если это просто учебное задание, то одно дело, если - часть чего то другого, то другое.

[Sergey112233]

GWolf,
здравствуйте.

Это не учебное задание. Скорее один из путей, правда, до вершины еще далековато
Задается код через Msgbox, например, 173456. Ищется в столбце А последняя группа записей этого кода. Это строчки 15-18. В столбце С в этих строчках автоматически проставляется дата.
Далее, задается иной код. Опять должна находиться последняя группа записей иного кода и построчно проставляться значение Даты в столбце С
и т.д.

Планирую перемещение построчно сделать с помощью вызываемой функции или программы, например, так:

Код Выделить Развернуть

Public Function Runner1(Poz1 As Range, n As Integer)
m = 0 ' начальное значение строки поиска искомого кода
Do
If Poz1 <> Poz1.Offset(m, 0) Then Exit Do
Poz1.Offset(m, n) = Date
n = n + 2
Poz1.Offset(m, n) = Date + k
n = n - 2
m = m - 1 ' движение поиска вверх построчно
Loop
End Function

[GWolf]

Доброго дня ув. Sergey112233!

Что ж, один из путей:

Предполагаю, что заполнение таблицы идет сверьху - вниз. Если это так, то

Код Выделить Развернуть

Sub road() '- открываем процедуру
    Dim i As Long, nREnd As Long
    Dim gruppa As String
    Dim blok As Range
   
    'запросим значение группы
    gruppa = InputBox("Введите значение группы:", "")
    'если ввод пуст - завершим процедуру
    If gruppa = "" Then Exit Sub
    'если же непуст, то:
    With ThisWorkbook '- для текущей рабочей книги
        With .ActiveSheet '- и активного листа в ней
            'определяем занятую данными область листа == Start ==
            Set blok = .UsedRange
            nREnd = blok.Row + blok.Rows.Count - 1
            Set blok = Nothing
            'определяем занятую данными область листа == Stop ==
           
            If nREnd < 1 Then 'если таблица пуста, т. е. занятая область листа = 0
                Exit Sub ' - завершим процедуру
            Else 'если НЕТ
                'организуем цикл (поскольку нам известны и стартовое и _
                 конечные значения, то это цикл For ... Next с оператор _
                 ом Step, что бы организовать обратное движение ...
                 
                i = 0 '- начальное значение счетчика итераций цикла
                For i = nREnd To 2 Step -1 'с перемещением снизу - вверьх, на один шаг
                    If .Cells(i, 1).Text = gruppa Then '-если значение в ячейке = заданному значению группы
                        oDates i, .ActiveSheet.Name '- передаем в функцию номер строки и имя рабочего листа
                        Exit For ' - по завершении работы функции завершаем цикл поиска.
                    End If
                Next i
            End If
        End With
    End With
End Sub

Function oDates(nR As Long, WSname As String)
    With ThisWorkbook.Worksheets(WSname)
        'здесь мы тоже организуем цикл, но поскольку незнаем, _
         сколько значений входит в группу, то Do ... Loop, и _
         будем его выполнять, пока верно условие: .Cells(nR, 1).Text = .Cells(nR + 1, 1).Text
        Do
            .Cells(nR, 3) = Format(Date, "dd.mm.yyyy")
            nR = nR - 1
        Loop While .Cells(nR, 1).Text = .Cells(nR + 1, 1).Text
    End With
   
    nR = 0
    WSname = ""
End Function

Я постарался МАКСИМАЛЬНО прокоментировать то, что делает макрос. Выполнил ли я Вашу задачу?

[Sergey112233]

GWolf,
Добрый вечер.
Профессионально и  еще раз профессионально, но понятно!
С удовольствием читаю Ваш вариант. Нашел примеры применения некоторых конструкций, которые хотелось бы прочитать в книге. Спасибо.

[Sergey112233]

GWolf,
уважаемые форумчане.

На этом месте останов - ошибка 438

Код Выделить Развернуть

oDates i, .ActiveSheet.Name '- передаем в функцию номер строки и имя рабочего листа       

[nilem]

Попробуйте так:
oDates i, .Name
т.к. все происходит внутри With ActiveSheet

[Sergey112233]

nilem,
Отлично работает. Спасибо

[GWolf]

Попробуйте так:
oDates i, .Name
т.к. все происходит внутри With ActiveSheet

Спасибо ув. nilem! А ведь верно!