Excel VBA创建新工作表时动态超链接位置异常问题求助

现有VBA代码实现点击Home工作表按钮，输入名称后创建对应工作表，同时在Home表A列生成超链接。但超链接始终固定在A8单元格，需求是新超链接创建在之前超链接下方第2个单元格，通过LastRow实现。

原代码如下：

Sub add_new_sheet()

'''Input Box for Unit Name

Dim i As Variant
Dim LastRow As Long
Dim LastRow2 As Long
Dim shtA As Worksheet
Dim shtB As Worksheet

Set shtA = Worksheets("home")
Set shtB = Worksheets("Base Data")
LastRow = shtB.Cells(shtB.Rows.Count, "A").End(xlUp).Row + 1
LastRow2 = shtA.Cells(shtA.Rows.Count, "A").End(xlUp).Row + 2

i = InputBox("Enter Name of Unit")
'shtA.Cells(LastRow, 1).Value = i
shtB.Cells(LastRow, 1).Value = i

Dim sht_N As Worksheet

Set sht_N = ActiveWorkbook.Sheets("CoTemplate1")


'''End Unit Name

Dim Link As String
Dim oRng As Range

Link = i
Set oRng = shtA.Cells.Range("A8:A" & LastRow2 + 2)
'Set oRng = shtB.Cells(LastRow, 1)

For rep = 1 To (Worksheets.Count)
If LCase(Sheets(rep).Name) = LCase(Link) Then

MsgBox "this sheet already exists"
Exit Sub
End If

Next

Sheets("coTemplate1").Visible = True
Sheets("coTemplate1").Copy after:=Sheets(Sheets.Count)


ActiveWindow.ActiveSheet.Name = Link
'Sheets("Test").Visible = True

shtA.Activate
shtA.Hyperlinks.Add oRng, "", "'" & Link & "'!A1", _
"Go to " & Link, Link

'Set oRng = Nothing

End Sub

问题分析 #

1. 原代码中Set oRng = shtA.Cells.Range("A8:A" & LastRow2 + 2)错误定义了单元格区域，而非单个目标单元格，导致超链接位置异常
2. LastRow2计算逻辑正确，但后续叠加了多余的+2，造成定位偏移错误

修正后的代码 #

Sub add_new_sheet()
    ' 声明变量
    Dim unitName As Variant
    Dim lastRowBaseData As Long
    Dim lastRowHome As Long
    Dim shtHome As Worksheet
    Dim shtBaseData As Worksheet
    Dim targetRng As Range
    Dim linkSheetName As String
    
    ' 绑定工作表
    Set shtHome = Worksheets("home")
    Set shtBaseData = Worksheets("Base Data")
    
    ' 获取Base Data表A列最后一行+1，用于写入新名称
    lastRowBaseData = shtBaseData.Cells(shtBaseData.Rows.Count, "A").End(xlUp).Row + 1
    ' 获取Home表A列最后一行+2，作为新超链接的位置（下方第2格）
    lastRowHome = shtHome.Cells(shtHome.Rows.Count, "A").End(xlUp).Row + 2
    
    ' 输入单元名称
    unitName = InputBox("Enter Name of Unit")
    ' 未输入则退出
    If unitName = "" Then Exit Sub
    
    ' 写入名称到Base Data表
    shtBaseData.Cells(lastRowBaseData, 1).Value = unitName
    linkSheetName = unitName
    
    ' 检查工作表是否已存在
    For Each ws In ThisWorkbook.Worksheets
        If LCase(ws.Name) = LCase(linkSheetName) Then
            MsgBox "This sheet already exists"
            Exit Sub
        End If
    Next ws
    
    ' 复制模板并命名
    Worksheets("CoTemplate1").Visible = True
    Worksheets("CoTemplate1").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    ActiveSheet.Name = linkSheetName
    
    ' 设置超链接目标单元格（Home表A列的目标行）
    Set targetRng = shtHome.Cells(lastRowHome, 1)
    
    ' 添加超链接
    shtHome.Hyperlinks.Add _
        Anchor:=targetRng, _
        Address:="", _
        SubAddress:="'" & linkSheetName & "'!A1", _
        ScreenTip:="Go to " & linkSheetName, _
        TextToDisplay:=linkSheetName
End Sub

关键修改点 #

1. 修正超链接目标单元格：将区域定位改为单个单元格shtHome.Cells(lastRowHome, 1)，确保每次定位到正确位置
2. 移除多余偏移：删除原代码中LastRow2 + 2的重复偏移计算
3. 优化变量命名：让代码逻辑更易读，比如i改为unitName、shtA改为shtHome
4. 增加空输入判断：避免用户未输入名称时执行无效逻辑
5. 优化工作表检查：用For Each循环替代索引循环，代码更简洁高效

内容的提问来源于stack exchange，提问作者Ryan Data Guy