根据超链接单击将单元格值复制并粘贴到另一个工作表

Question

希望您能够帮助我。

我想根据您单击该单元格上的超链接的时间复制和粘贴单元格值。

因此，例如，我有一个名为 Form1 的工作表，我想单击 A 列中的一个 ID，然后它将复制该单元格的值并将其粘贴到工作表 1 中的 B2，然后将我带到工作表 1。

目前我有一个宏，允许我点击一个活动单元格，然后按下一个按钮，然后执行上面提到的操作。 我只是认为超链接印刷机会更加用户友好并且会导致更少的错误。

这是我现在的代码：

Sub Rectangle13_Click()

ActiveCell.Copy Destination:=Sheets(“Sheet1”).range(“B2”)

Worksheets(“Sheet1”).Activate

End Sub

任何帮助，将不胜感激！ 谢谢

Answer 1

工作表跟随超链接

• 将此代码复制到工作表Form1的工作表模块。 从那里运行第二个 sub 将A列转换为超链接。
• 点击离开。

Option Explicit

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    If Not Intersect(Columns("A"), Target.Range) Is Nothing Then
        Me.Parent.Worksheets("Sheet1").Range("B2").Value = Target.Range.Value
    End If
End Sub

' Run this to create hyperlinks out of the values in column 'A'
' which will point to cell 'B2' in 'Sheet1'. You can then reformat
' the cells (remove underline, change font color, ...).
Private Sub CreateHyperlinks()
    Dim lRow As Long: lRow = Range("A" & Rows.Count).End(xlUp).Row
    Dim cell As Range
    For Each cell In Range("A2:A" & lRow).Cells
        cell.Hyperlinks.Add cell, "", "Sheet1!B2", , CStr(cell.Value)
    Next cell
End Sub

Answer 2

我认为使用Hyperlik不方便。 如果您尝试更改单元格值，您不能简单地单击它并写一些东西......但是如果你想要那样，你可以通过下一种方式创建这样的超链接：

Sub testAddHyperlink()
   Dim DestSh As Worksheet
   Set DestSh = Sheets("Sheet1") 'you can use any sheet name here
   ActiveSheet.Hyperlinks.Add Range("A1"), Address:="", SubAddress:="'" & DestSh.name & "'" & "!A1"
   'it will keep the existing cell value
End Sub

然后，请复制表单代码模块中的下一个事件代码（超链接所在的位置）：

Option Explicit

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
  Dim rngCopy As Range, shDest As Worksheet
   Set shDest = Sheets("Sheet1") 'you may use here any sheet name
   shDest.Range("B2").value = Target.Parent.Value 'the sheet where the hyperlink targets, is already activated...
End Sub

Answer 3

如果您想使用BeforeDoubleClick方法，请将此代码粘贴到 VBA 编辑器中的Form1工作表 object 中...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Cells.Count = 1 And Target.Cells(1, 1).Column = 1 Then
        Cancel = True
        
        With ThisWorkbook.Worksheets("Sheet1")
            .Range("B2") = Target.Value
            .Activate
        End With
    End If
End Sub

...当然，这是一个基本示例，您可能需要相应地对其进行修改。 例如，当您双击时，如果第一行是 header，您可能希望忽略它并且不调用逻辑的核心部分。

那将做你想做的。