如何创建链接到宏代码的超链接进行剪切和粘贴？

2024-05-04 • 问答

这里是excel编程的新手，我用头撞墙，试图通过谷歌搜索来完成此操作，但似乎每次将地毯推下一个位置时，它就会从另一个笑声中弹出我有一个Excel工作表，上面有5个标签，每个项目中的coloum A是我希望可点击单元格所在的位置。单击该单元格时，我希望它在同一行上将其右边的4个单元格剪切并粘贴到下一个选项卡上。因此，单击A1将剪切B1，C1，D1，E1，并将其粘贴到下一个选项卡上，但粘贴到下一个可用行上。下一个选项卡也是如此，直到该行进入最后一个选项卡所有数据都在第一张纸上，其他所有数据都为空。因此，一旦我在第一张纸上单击它，我希望它移动到下一张纸，然后当我在下一张纸上单击它时，我希望它移动到第三张纸。

到目前为止，我有一个代码可以在我突出显示的单元格上创建超链接，但它显示（工作表名称！单元格编号），我想显示的是特定的txt而不是（完整的）或（已接收的）。每个选项卡的显示有所不同。我在第一张工作表中使用的代码可以将剪切行移至第二张工作表，但是我尝试将该代码粘贴到下一张工作表中，以将其移至第三张工作表，但是我一直遇到错误。

提前感谢您的帮助！我对此感到内，通常我会坐下来学习整个过程，但是我只是在这里等待时间。

模块中的代码

Sub Hyperactive()
    Dim nm As String

    nm = activeSheet.Name & "!"
    For Each r In Selection
        t = r.Text
        addy = nm & r.Address(0,0)
        activeSheet.Hyperlinks.Add Anchor:=r,Address:="",SubAddress:= _
            addy,TextToDisplay:=r.Text
    Next r
End Sub

工作表中的代码

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    Dim r As Range

    Set r = Range(Target.SubAddress)

    r.Offset(0,1).Resize(1,4).Cut
    Sheets("Wash Bay").Select
    Worksheets("Wash Bay").Range("B" & Rows.Count).End(xlUp).Offset(1).Select
    activeSheet.Paste

End Sub

我建议在这里使用Workbook_SheetFollowHyperlink事件。这是工作簿级事件，而不是工作表级<button type="button" value="Ok" onclick="y();"></button>事件。

从文档中

在Microsoft Excel中选择任何超链接时发生...

参数

Worksheet_FollowHyperlink ：包含超链接的Sh对象

Worksheet ：代表超链接目标的Target对象

将以下代码添加到Hyperlink模块（而不是工作表代码模块）中。

ThisWorkbook

重要说明：在当前状态下，这假定工作簿仅具有工作表（例如，没有图表表）。

编辑：如果工作簿除工作表之外还包含其他工作表类型，则可以使用此修订的代码：

Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object,ByVal Target As Hyperlink)
    If Sh.Index = Me.Worksheets.Count Then Exit Sub ' Do nothing if `Sh` is the last worksheet

    Dim nextWs As Worksheet
    Set nextWs = Me.Worksheets(Sh.Index + 1)

    With nextWs
        Dim lastRow As Long
        lastRow = .Range("B" & .Rows.Count).End(xlUp).Row
    End With

    Dim rng As Range
    Set rng = Sh.Range(Target.SubAddress)

    rng.Offset(,1).Resize(1,4).Cut Destination:=nextWs.Range("B" & lastRow + 1)

    Application.CutCopyMode = False
End Sub

第二次编辑：

我认为您可以将Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object,ByVal Target As Hyperlink) Dim indx As Long indx = GetWorksheetIndex(Sh) If indx = Me.Worksheets.Count Then Exit Sub Dim rng As Range Set rng = Sh.Range(Target.SubAddress) Dim nextWs As Worksheet Set nextWs = Me.Worksheets(indx + 1) With nextWs Dim lastRow As Long lastRow = .Range("B" & .Rows.Count).End(xlUp).Row End With rng.Offset(,4).Cut Destination:=nextWs.Range("B" & lastRow + 1) Application.CutCopyMode = False End Sub Private Function GetWorksheetIndex(ByVal ws As Worksheet) As Long Dim w As Worksheet For Each w In ws.Parent.Worksheets Dim counter As Long counter = counter + 1 If w.Name = ws.Name Then GetWorksheetIndex = counter Exit Function End If Next w End Function改写成这样：

HyperActive

然后在主要Sub HyperActive(ByVal rng As Range) Dim ws As Worksheet Set ws = rng.Parent Dim fullAddress As String fullAddress = "'" & ws.Name & "'!" & rng.Address ws.Hyperlinks.Add Anchor:=rng,Address:="",SubAddress:=fullAddress,TextToDisplay:=rng.Text End Sub代码中，添加以下行：

Workbook_SheetFollowHyperlink

如何创建链接到宏代码的超链接进行剪切和粘贴？

QQW1236 回答：如何创建链接到宏代码的超链接进行剪切和粘贴？

大家都在问