在多個工作表中更新外部單元格引用（使用vba宏）

Question

一般來說，我對VBA和Excel宏是完全陌生的，所以我將嘗試盡可能清楚地解釋我的困境。 基本上，我有兩個工作簿，一個是源工作簿，它包含一個具有近數千行和幾列的工作表，另一個是具有90多個工作表的工作簿，每個工作簿都有兩個表，這些表引用了源工作簿中的單元格（這些表涵蓋了每月的數據最近四個會計年度）。

我已經將大部分可以正常工作的自動化宏串在一起，但是我主要擔心的是它可以做得更好，特別是我有一段代碼：

'October
cellVarO = ActiveSheet.Range("B8").Formula
cellVarO = Right(cellVarO, 5)
Range("B8").Select
ActiveCell.Formula = "=OFFSET('C:\external\[reference_sheet.xls]Mnthly Rdgs'!" & cellVarO & ",0," & fyNum * 12 & ")"

需要注意的是，此代碼重復24次，每個月重復一次，並使用MID進行另一次迭代，以便我仍在從活動單元格公式中選擇正確的單元格值（將原始公式更改為包括OFFSET后）。 我覺得這很笨重，沒有必要，但這是我解決問題的唯一方法。 另一個問題是，它認為單元格引用將始終為5個字符長。 在某些情況下並非如此。

但是基本上我的月份是按列排列的，而我的年份是按行排列的，我的目的是查看單元格引用的單元格公式，選擇單元格值，然后使用OFFSET將值移動12列到最新的值，並將新值打印到最近的一年。 假設我有單元格公式：

='C:\external\[reference_sheet.xls]Mnthly Rdgs'!QR938

我的目標是在此處獲取單元格值（QR938）並將其右移12列。 有什么方法可以選擇單元格值（使用MID / RIGHT除外）並將其分配給要偏移的變量？ 除了使用OFFSET之外，還有更好的方法將單元格值移動12列嗎？ 最后，有沒有辦法在多個格式相似的工作表上執行相同的操作？

Answer 1

看看是否有幫助

用於測試主要代碼：

Sub Tester()

    'offset 12 cols to right
    OffsetFormulaReference ActiveSheet.Range("B8"), 0, 12

    'offset 12 cols to left
    OffsetFormulaReference ActiveSheet.Range("B9"), 0, -12

    'offset 12 rows down
    OffsetFormulaReference ActiveSheet.Range("B10"), 12, 0

    'offset 12 rows up
    OffsetFormulaReference ActiveSheet.Range("B11"), -12, 0


    'EDIT: loop over sheets and edit a specific range
    Dim c As Range, sht as WorkSheet
    For Each sht in ThisWorkbook.Sheets
        For each c in sht.Range("B8:B20").Cells
            OffsetFormulaReference c, 12, 0
        Next c
    Next sht

End Sub

從帶有外部引用的單元格中獲取公式並將其移至指定的行數/列數的實用方法：

Sub OffsetFormulaReference(c As Range, offsetRows, offsetCols)

    Dim origForm As String, origAddr As String
    Dim arr, rng As Range, newAddr As String

    If c.HasFormula Then
        origForm = c.Formula
        '(e.g.)  ='C:\external\[reference_sheet.xls]Mnthly Rdgs'!QR938

        If InStr(origForm, "!") > 0 Then

            arr = Split(origForm, "!") 'arr(1) = "QR938"
            Set rng = ActiveSheet.Range(arr(1)) 'get a range reference
            Set rng = rng.Offset(offsetRows, offsetCols) 'move the reference
            newAddr = rng.Address(False, False) 'get the offset address
            'replace old formula with new offset reference
            c.Formula = arr(0) & "!" & newAddr
        End If
    End If
End Sub

注意：如果嘗試使用Offset()將rng引用移到圖紙的限制之外（例如，行或列<1），則會出現錯誤。 您可以添加邏輯以處理可能的問題。