Question

我有一个索引作为第一张表的工作簿。每个后续工作表都是潜水日志。由于我是众多使用此工作簿的人之一，因此需要尽可能“自动”（因为人们很懒惰）......

每个日志都有一个“New Dive”的宏按钮。宏创建一个新工作表，使用新工作表编号（潜水编号）命名并清除准备填写的相关数据。目前索引表需要手动填充，但它被忽略。

我关闭了宏，但这是让我难以接受的最后一步。我已经尝试Activecell.FormulaR1C1 and Cells(r,c) =...接近了，但没有一块馅饼。我在这方面也很新。

这是我的代码

Sub Add_links()
'
' Add_links Macro
' Adds links to the index sheet so it 'fills itself in'... 

' Each dive is on the row 9 more than the dive number (bear in mind each log is 50 higher than the previous)

Dim Divenumber As Double
Dim Rownumber As Double

Range("I7").Select: Divenumber = ActiveCell.FormulaR1C1

' Make Linenumber the same as Divenumber.
' Do a loop of reducing the Linenumber by 50 until it's in the range 1 to 50.
' Add 9 to that and it becomes the row number of the index sheet

Rownumber = Divenumber

Do
Rownumber = Rownumber - 50
Loop While Rownumber > 50

Rownumber = Rownumber + 9

Worksheets("Dive Index").Activate

Range("A" & Rownumber).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
    "'Dive " & Divenumber & "'!A1"
'Project number (in cell F4)
Range("B" & Rownumber).Select
ActiveCell.FormulaR1C1 = "='Dive " & Divenumber & "'!F4"
'Task(in cell C7)
Range("C" & Rownumber & ":G" & Rownumber).Select
ActiveCell.FormulaR1C1 = "='Dive " & Divenumber & "'!C7"
'Start date (in cell C21)
Range("H" & Rownumber).Select
ActiveCell.FormulaR1C1 = "='Dive " & Divenumber & Chr(39) & "!$C$21"
'Start time (in cell E21)
Range("I" & Rownumber).Select
ActiveCell.FormulaR1C1 = "='Dive " & Divenumber & Chr(39) & "!$E$21"
'End date (in cell F21)
Range("J" & Rownumber & ":K" & Rownumber).Select
ActiveCell.FormulaR1C1 = "='Dive " & Divenumber & Chr(39) & "!$F$21"
'End time (in cell G21)
Range("L" & Rownumber).Select
ActiveCell.FormulaR1C1 = "='Dive " & Divenumber & Chr(39) & "!$G$21"

Sheets("Dive " & Divenumber).Select
Range("A23").Select
End Sub

这个让我最接近..

ActiveCell.FormulaR1C1 = "='Dive " & Divenumber & "'!F4"

但在细胞中添加了一些不需要的东西..看起来像这样......

='Dive 53'!'F4'（应为='Dive 53'!F4）

Answer 1

这种方法避免使用超链接（我发现很难维护），而是使用索引表的BeforeDoubleClick事件来提供等效功能。

此代码进入Dive Index工作表的代码模块，以便它获取索引上的双击事件：

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    '// This function is called whenever the sheet is double-clicked
    '// It checks the value of the target (selected) cell, to see if it is a reference
    '// to a dive sheet. If so, it activates that sheet

    '// Get hold of the contents of the target cell
    Dim sTarget As String: sTarget = Target.Cells(1, 1).Value

    '// Check if it refers to a dive sheet
    If Left(sTarget, 5) = "Dive " Then
        Dim wsTarget As Worksheet
        On Error Resume Next
            '// Try to find the worksheet referred to by the target cell
            Set wsTarget = Worksheets(sTarget)
        On Error GoTo 0

        '// Check that a target sheet was found
        If wsTarget Is Nothing Then
            Exit Sub
        End If

        '// Activate the sheet
        wsTarget.Activate

        '// Cancel the default action for double-click
        Cancel = True

    End If


End Sub

这是您的函数Add_Links（）的代码。我不确定你是如何调用它的，但它与你的例子一样有效，除了我使用了一些更简单的技术。

Option Explicit

Sub Add_links()

        '
        ' Add_links Macro
        ' Adds links to the index sheet so it 'fills itself in'...

        ' Each dive is on the row 9 more than the dive number (bear in mind each log is 50 higher than the previous)

        Dim Divenumber As Double
        Dim Rownumber As Double


        Dim wsDive As Worksheet
        Set wsDive = ActiveSheet

        '// Dive number is in cell I7 of the sheet
        Divenumber = wsDive.Range("I7").Value

        '// Make sure the sheet name corresponds to the dive number
        Dim sDiveName As String
        sDiveName = "Dive " & Divenumber
        wsDive.Name = sDiveName


        '// Calculate the row number for the index entry
        '-- -- Rownumber = Divenumber Mod 50 + 9
        '// Use below if dive numbers in sheet run from 1 to 50, not 0 to 49
        Rownumber = (Divenumber - 1) Mod 50 + 10

        '// Get a reference to the index sheet
        Dim wsIndex As Worksheet: Set wsIndex = Worksheets("Dive Index")

        '// Get a reference to column A in the index entry row
        Dim rLink As Range: Set rLink = wsIndex.Range("A" & Rownumber)

        '// Put the Dive name into column A
        rLink.Value = sDiveName



        '// Reference data from the dive sheet into the index sheet ================

        '// Project number (in cell F4)
        rLink.Offset(0, 1).Formula = ReferenceToCell(wsDive.Range("F4")) '// Index Column B

        '// Task(in cell C7)
        rLink.Offset(0, 2).Formula = ReferenceToCell(wsDive.Range("C7")) '// Index Column C

        '// Start date (in cell C21)
        rLink.Offset(0, 7).Formula = ReferenceToCell(wsDive.Range("C21")) '// Index Column H

        '// Start time (in cell E21)
        rLink.Offset(0, 8).Formula = ReferenceToCell(wsDive.Range("E21")) '// Index Column I

        '// End date (in cell F21)
        rLink.Offset(0, 9).Formula = ReferenceToCell(wsDive.Range("F21")) '// Index Column J

        '// End time (in cell G21)
        rLink.Offset(0, 11).Formula = ReferenceToCell(wsDive.Range("G21")) '// Index Column L


End Sub

Private Function ReferenceToCell(rCell As Range) As String
    '// This function returns a formula that references the value of the given cell
    ReferenceToCell = "='" & rCell.Parent.Name & "'!" & rCell.Cells(1, 1).Address

End Function

Excel VBA宏。如何将绝对单元格引用写入单元格

1 个答案: