Как я нацеливаюсь на определенный диапазон ячеек от выбора?

Question

Я хочу иметь возможность выбрать любое количество ячеек и нажать кнопку, которая будет регистрировать информацию. вся информация располагается горизонтально, что означает, что если я выберу L10 и нажму кнопку, N10, O10 и P10 будут изменены в соответствии с тем, что я им скажу.

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

If cel.Value = Range("g16") Then                             

       Range("ff16").Value = True
       Range("p16").Value = Now

          If Range("m16").Value <= 0 Then
             Range("o16").Value = Range("o16").Value & " | " & VarNUMCB

          Else
          End If



  Else
    If cel.Value = Range("e16") Then
       Range("ff16").Value = True
       Range("p16").Value = Now
             If Range("m16").Value <= 0 Then
                Range("o16").Value = Range("o16").Value & " | " & VarNUMCB
             Else
             End If
    Else


    End If
  End If

Ожидаемый результат:

L10 выбрано, L11 выбрано, L18 выбрано, L23 выбрано -> кнопка нажата -> всплывающее окно с запросом на подпись -> N10, N11, N18, N23 помечено, O10, O11, O18, O23 показывает подпись и P10, P11, P18, P23 показывает дату и время.

бывает: если значение из L окажется таким же, как и любая другая случайная ячейка L, он применит изменения к обоим, что я не хочу.

Answer 1

Может быть, что-то вроде того, что вы ищете:

Sub tgr()

    Dim rSelected As Range
    Dim rCell As Range
    Dim sSignature As String
    Dim dtTimeStamp As Date

    'Verify that the current selection is a range (and not a chart or something)
    If TypeName(Selection) <> "Range" Then
        MsgBox "Invalid selection. Exiting Macro.", , "Error"
        Exit Sub
    End If

    'Get the signature
    sSignature = InputBox("Provide Signature", "Signature")
    If Len(sSignature) = 0 Then Exit Sub    'Pressed cancel

    'Get the current date and time
    dtTimeStamp = Now

    'Only evaluate selected cells in column L, ignore other selected cells
    Set rSelected = Intersect(Selection.Parent.Columns("L"), Selection)
    If rSelected Is Nothing Then
        MsgBox "Must select cell(s) in column L. Exiting Macro.", , "Error"
        Exit Sub
    End If

    'Loop through each selected L cell
    For Each rCell In rSelected.Cells
        '"Tick" same row, column N
        rCell.Offset(, 2).Value = "Tick"

        'Signature in same row, column O
        rCell.Offset(, 3).Value = sSignature

        'Date and time in same row, column P
        rCell.Offset(, 4).Value = dtTimeStamp
    Next rCell

End Sub