在 Excel 中使用宏来超链接大量数据并跨工作簿工作

Question

Example Table

每个月我都必须创建新工作簿并将所有数据手动复制到新工作簿。所有数据都超链接到上个月的数据。我尝试为此任务创建一个按钮。

这是我目前得到的..

Sub Macro1()

'open a new file template
Workbooks.Open Filename:= _
    "C:\Users\ACER\Google Drive\A.C status\A.C STATUS MASTER FILE.xlsm"
ActiveWindow.WindowState = xlNormal
With ActiveWindow
    .Top = 14.5
    .Left = 625.75
End With

Range("N3").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R3C3"
Range("O3").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R3C4"
Range("P3").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R3C5"
Range("Q3").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R3C6"
Range("R3").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R3C7"
Range("S3").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R3C8"
Range("T3").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R3C9"
Range("N6").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R6C3"
Range("O6").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R6C4"
Range("P6").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R6C5"
Range("Q6").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R6C6"
Range("R6").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R6C7"
Range("S6").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R6C8"
Range("T6").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R6C9"
Range("N9").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R9C3"
Range("O9").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R9C4"
Range("P9").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R9C5"
Range("Q9").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R9C6"
Range("R9").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R9C7"
Range("S9").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R9C8"
Range("T9").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R9C9"
Range("N12").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R12C3"
Range("O12").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R12C4"
Range("P12").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R12C5"
Range("Q12").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R12C6"
Range("R12").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R12C7"
Range("S12").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R12C8"
Range("T12").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R12C9"
Range("N15").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R15C3"
Range("O15").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R15C4"
Range("P15").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R15C5"
Range("Q15").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R15C6"
Range("R15").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R15C7"
Range("S15").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R15C8"
Range("T15").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R15C9"
Range("N18").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R18C3"
Range("O18").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R18C4"
Range("P18").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R18C5"
Range("Q18").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R18C6"
Range("R18").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R18C7"
Range("S18").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R18C8"
Range("T18").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R18C9"
Range("N21").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R21C3"
Range("O21").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R21C4"
Range("P21").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R21C5"
Range("Q21").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R21C6"
Range("R21").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R21C7"
Range("S21").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R21C8"
Range("T21").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R21C9"
Range("N24").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R24C3"
Range("O24").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R24C4"
Range("P24").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R24C5"
Range("Q24").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R24C6"
Range("R24").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R24C7"
Range("S24").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R24C8"
Range("T24").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R24C9"
Range("N27").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R27C3"
Range("O27").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R27C4"
Range("P27").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R27C5"
Range("Q27").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R27C6"
Range("R27").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R27C7"
Range("S27").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R27C8"
Range("T27").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R27C9"
Range("N30").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R30C3"
Range("O30").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R30C4"
Range("P30").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R30C5"
Range("Q30").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R30C6"
Range("R30").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R30C7"
Range("S30").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R30C8"
Range("T30").Select
ActiveCell.FormulaR1C1 = "='[wksData]Data Input'!R30C9"

ActiveWorkbook.SaveAs Filename:= _
    "C:\Users\ACER\Google Drive\A.C status\A.C STATUS.xlsm", FileFormat:= _
    xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

最初“wksData”是我需要从中复制的名称文件。我将其更改为“wksData”，以便此代码适用于不同的工作簿。 Excel 将要求用户选择一个文件为“wksData”。

enter image description here

但是，问题是，每次代码到达“wksData”时，excel都会一次又一次地问我..如何让它只问一次？

Answer 1

您可以通过提供工作簿路径来完全避免文件对话框。

我重构了您的代码，以便将单元格链接添加为数组公式。这简化了代码，并且使某人更难无意中更改公式。

Sub LinkLastMonth()
    Dim x As Long
    Dim Path As String, FileName As String
    Dim fDialog As FileDialog, result As Integer
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

    'Optional: FileDialog properties
    fDialog.AllowMultiSelect = False
    fDialog.Title = "Select a file"
    fDialog.InitialFileName = Environ("USERPROFILE") & "\Dropbox\On the go ordering"
    'Optional: Add filters
    fDialog.Filters.Clear
    fDialog.Filters.Add "Excel files", "*.xls, *.xlsx, *.xlsm"
    fDialog.Filters.Add "All files", "*.*"

    'Show the dialog. -1 means success!
    If fDialog.Show = -1 Then
        x = InStrRev(fDialog.SelectedItems(1), "\")
        Path = Left(fDialog.SelectedItems(1), x)
        FileName = Right(fDialog.SelectedItems(1), Len(fDialog.SelectedItems(1)) - x)

        If Right(Path, 1) <> "\" Then Path = Path & "\"

        For x = 3 To 30 Step 3

            Rows(x).Columns("N:T").FormulaArray = "='" & Path & "[" & FileName & "]Data Input'!" & Rows(x).Columns("C:I").Address

        Next
    End If
End Sub