如何从选择中定位特定范围的单元格?

时间:2019-03-28 14:21:16

标签: excel vba

我想要的是能够选择任意数量的单元格,然后按一下将注册信息的按钮。所有信息都是水平放置的,这意味着如果我选择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单元相同,它将对这两者应用更改,而我不想这样做。

1 个答案:

答案 0 :(得分: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