Question

我有一张提供全价优惠的工作表和一份单独的工作表，根据条件等因素对此价格进行更改。

由于有相当多的全价优惠，我认为一个简单的方法是让每个价格成为一个超链接，复制到工作表中的一个单元格进行价格调整，价格会自动调整。

我对VBA并不擅长，但我已经想出了一个基本代码。

Dim ClickCell As String

Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
    If Sh.Name = "Book 1" Then
        If ClickCell = "A3" Then
            Sheets("Book 2").Range("B2").Value = "Sample Data"
        End If
    End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name = "Book 1" Then
        ClickCell = Target.Address(False, False)
    End If

End Sub

此代码的主要问题（我将能够将IF语句更改为涵盖包含价格的整个列的范围），是我无法获取包含超链接的单元格的值并将其粘贴到细胞B2。 ActiveCell.Value似乎只复制B2的值（应该粘贴价格的单元格，基本上用自己替换该单元格的值），而且BeforeDoubleClick似乎根本不适合我。

最后，我一直在将此代码作为工作簿模块运行，因为它运行在不同的工作表中，是吗？

编辑：要求提供数据样本（我不确定这是否正确）。

Sheet1

Sheet2

Answer 1

目标包含超链接所在的单元格。您可以从Target.SubAddress获取位置（请参阅代码中的注释）：

Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
    Dim subAddress() As String

    If Sh.Name = "Book 1" Then
        ''.SubAddress is for example 'Book 2'!B2
        ''Get sheet name by splitting into an array by delimiter !
        subAddress = Split(Target.subAddress, "!")
        ''Trim ' from the first item
        subAddress(0) = Replace(subAddress(0), "'", "")

        Sheets(subAddress(0)).Range(Target.subAddress).Value = Target.Range.Value
    End If
End Sub

单击超链接更改了不同工作表上单元格的值以链接单元格的值

1 个答案: