使用 VBA 复制表宏和公式 r1c1

Question

也许我已经盯着这个太久了，但是我有一个可以在 Excel 中复制工作表的宏。我还想做的是将它包含在循环中（只是这个录制的宏中的 R1C1 公式）：

Sub Macro4()
'
' Macro4 Macro
'
' Keyboard Shortcut: Ctrl+a
'
Sheets("<Null>").Select
ActiveSheet.Buttons.Add(541.5, 97.5, 95.25, 43.5).Select
ActiveSheet.Buttons.Add(541.5, 169.5, 94.5, 42.75).Select
Sheets("<Null>").Copy After:=Sheets(3)
ActiveCell.FormulaR1C1 = "='Dividing Walls Only'!RC[-2]"
Range("C4").Select
Sheets("<Null> (2)").Select
ActiveSheet.Buttons.Add(541.5, 97.5, 95.25, 43.5).Select
ActiveSheet.Buttons.Add(541.5, 169.5, 95.25, 42.75).Select
Sheets("<Null> (2)").Copy After:=Sheets(4)
Range("C3").Select
ActiveCell.FormulaR1C1 = "='Dividing Walls Only'!R[1]C[-2]"
Range("C4").Select
Sheets("<Null> (3)").Select
ActiveSheet.Buttons.Add(541.5, 97.5, 95.25, 43.5).Select
ActiveSheet.Buttons.Add(541.5, 169.5, 95.25, 42.75).Select
Sheets("<Null> (3)").Copy After:=Sheets(5)
Range("C3").Select
ActiveCell.FormulaR1C1 = "='Dividing Walls Only'!R[2]C[-2]"
Range("C4").Select
End Sub

显然，重复 180 次是愚蠢的。这是我已经拥有的 Copy Sheet 宏：

Sub CopySheet()

Call OptimizeCode_Begin

Dim x As Integer

x = InputBox("Enter number of times to copy active sheet")
For numtimes = 1 To x
   'Loop by using x as the index number to make x number copies
   ActiveWorkbook.ActiveSheet.Copy _
      After:=ActiveWorkbook.Sheets(3)
      'Put copies in front of Sheet3
      'Might need to move the new sheets

Next

Call OptimizeCode_End

End Sub

我想做的是合并一个嵌套循环或自动推进每张工作表的 R1C1 公式，这样我就不必在所有工作表复制后输入我试图引用的单元格。任何帮助将不胜感激。

谢谢！

贾斯汀

Answer 1

从您的帖子中我了解到，下面的代码将根据用户在InputBox 中选择的次数运行，并在最后一次之后复制一张Sheet。

对于每个创建的工作表，它将向 Cell C4 添加一个公式，我只是不确定为每个工作表推进公式的逻辑。

Sub CopySheets()

Dim x           As Long
Dim numtimes    As Long
Dim newSht      As Worksheet


x = Application.InputBox("Enter number of times to copy active sheet", Default:=1, Type:=1)

' optimize run time
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayAlerts = False

' create the Buttons on the original sheet
' (will be copied inside the loop for all other sheets)
ActiveSheet.Buttons.Add(541.5, 97.5, 95.25, 43.5).Select
ActiveSheet.Buttons.Add(541.5, 169.5, 94.5, 42.75).Select

For numtimes = 1 To x

    'Loop by using x as the index number to make x number copies
     ActiveWorkbook.ActiveSheet.Copy _
            After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)

    Set newSht = ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)

    ' give the new Sheet Name the reference of num of times
    newSht.Name = "<NULL " & numtimes & ">"

    ' advance the row number in the formula
    newSht.Range("C3").FormulaR1C1 = "='Dividing Walls Only'!R[" & numtimes & "1]C[-2]"

Next numtimes

' Resume Settings
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayAlerts = True

End Sub

Answer 2

也许这就是你所追求的：

Option Explicit

Sub CopySheet()
    Dim numtimes As Long, x As Long, rowIndex As Long

    Call OptimizeCode_Begin
    rowIndex = 4 '<-- this is the row index that will be used in the formula that'll be written in the first new sheet
    numtimes = Application.InputBox("Enter number of times to copy active sheet", Default:=1, Type:=1)
    For x = 1 To numtimes
        'Loop by using x as the index number to make x number copies
        ActiveWorkbook.ActiveSheet.Copy _
        After:=ActiveWorkbook.Sheets(3)
        Range("C3").Formula = "='Dividing Walls Only'!A" & rowIndex '<--| write formula in the new sheet cell "C3" referencing "Dividing Walls Only" worksheet column "A" cell in current 'rowIndex'
        rowIndex = rowIndex + 1 '<--| update row index for subsequent new sheet formula
    Next
    Call OptimizeCode_End
End Sub

你看我使用 Excel（即Application）InputBox() 方法而不是 VBA InputBox() 一个，因为前者允许您指定 return数据类型也（类型：=1 用于数字输入），从而强制用户输入想要的。