用基于不同工作表VBA的不同值替换多个工作表中的公式

Question

我当前的代码创建了 9 个名为“MasterCalculator”的工作表副本。它通过计算另一张称为“LLP 光盘表”的第 1 行（从 C 列开始）中填写的单元格的数量来决定要命名的副本数量。然后命名创建的 9 个工作表中的每一个。 Sheet 1 的名称来自“LLP Disc Sheet”中的 C1，Sheet 2 的名称来自“LLP Disc Sheet”中的 D1，Sheet 3 的名称来自“LLP Disc Sheet”中的 E1，以此类推。

Option Explicit

Public Sub NewSheets()
Dim shCol   As Integer
Dim i       As Integer
Dim ws      As Worksheet
Dim sh      As Worksheet
Set ws = Sheets("MasterCalculator")
Set sh = Sheets("LLP Disc Sheet")
Application.ScreenUpdating = 0
Application.EnableEvents = 0
shCol = 2
sh.Activate
For i = 2 To sh.Range("A1:Z1").Cells.SpecialCells(xlCellTypeConstants).Count
    shCol = shCol + 1
    Application.StatusBar = "Processing " & sh.Cells(1, shCol).Text & Format(i /     sh.Range("A1:Z1").Cells.SpecialCells(xlCellTypeConstants).Count, "  #0.0 %")
    Select Case shCol
    Case Is = 3
        ws.Copy After:=sh
    Case Else
        ws.Copy After:=Sheets(sh.Cells(1, shCol - 1).Text)
    End Select
    ActiveSheet.Name = sh.Cells(1, shCol).Text  
    Application.CutCopyMode = False
Next i
sh.Activate
Application.StatusBar = 0
Application.EnableEvents = 1
Application.ScreenUpdating = 1
Application.CalculateFull
End Sub

现在所有工作表都已创建并命名...我现在想更新每个工作表中的公式，因为它们是名为“MasterCalculator”的工作表的副本。我需要更新每张工作表中的 2 个单元格 - 单元格 B1 和单元格 M4。单元格 B1 包含公式“=+'LLP Disc Sheet'!C1”。基于“LLP Disc Sheet”中的 C1 创建的工作表可以保留此公式。但是，根据“LLP Disc Sheet”中的 D1 创建和命名的下一张表（表 2）需要更新为“=+'LLP Disc Sheet'!D1”。这继续与其余的床单。下一个必须更改为 =+'LLP Disc Sheet'!E1 等等。如何创建代码以用更新的公式替换每个新创建的工作表中的该单元格，该公式仅将其更改为在“LLP 光盘表”中引用一个单元格的单元格？

ActiveSheet.Range(“B1:M4”).Replace_
What: ="LLP Disc Sheet'!C1", Replacement:="LLP Disc Sheet'!D1”,_    ‘but I want it to continue to the next sheet to replace D1 with E1 and so on until all of the B1 cells match their sheet names (it also allow all the data to be filled in). All of these will be found in cell B1 in the MasterCalculator copies 
What: ="LLP Disc Sheet'!$C$1:$C$", Replacement:=" LLP Disc Sheet'!$D$1:$D$”,_   ‘but I want it to continue to the next sheet to replace $D$1 with E$1$ and $D$ with $E$ and so on until all of the M4 cells are set to 0. 
SearchOrder:=xlByRows, MatchCase:=True

Answer 1

使用formulaR1C1

Option Explicit

Public Sub NewSheets()

    Dim wb As Workbook, ws As Worksheet, wsMaster As Worksheet
    Dim iLastCol As Integer, iCol As Integer
    Dim s As String, n As Integer

    Set wb = ThisWorkbook
    Set wsMaster = wb.Sheets("MasterCalculator")
    Set ws = wb.Sheets("LLP Disc Sheet")
    iLastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column

    n = wb.Sheets.Count
    For iCol = 3 To iLastCol
        s = ws.Cells(1, iCol) ' sheet name
        If Len(s) > 0 Then
            wsMaster.Copy After:=Sheets(n)
            n = n + 1
            wb.Sheets(n).Name = s
            wb.Sheets(n).Range("B1,M4").FormulaR1C1 = "='" & ws.Name & "'!R1C" & iCol
        End If
    Next

    MsgBox iLastCol - 2 & " sheets added", vbInformation

End Sub