VBA代码为表

Question

的最后一列采用不同的比例这是我到目前为止有：

Sub test() 
    Dim r As Range, n As Integer, i As Integer 
    On Error Resume Next 
    Set r = Application.InputBox("Select the range", Type:=8) 
    On Error GoTo 0 
    If r Is Nothing Then Exit Sub 
    n = Application.InputBox("How many departments?") 
    c = ActiveCell.Column 
    r.Copy 
    For i = 1 To n 
     Cells(ActiveCell.Row, c + (i - 1) * (r.Columns.Count + 1)).Activate 
     ActiveCell.PasteSpecial Paste:=xlPasteValues 
    Next i 
    Application.CutCopyMode = False 
End Sub 

到目前为止，宏，

1. 提示用户选择一个范围。范围将是另一个工作表中的表格。
2. 然后，它会再次提示用户询问有多少个部门，并且根据该数量，它将在新工作表中将选定范围复制特定的次数。
3. 下一步是 - 根据部门类型 - 用户需要输入一个百分比并将该百分比应用于所选范围的最后一列，即销售收入。

例如，如果用户输入了5个部门，它将在新的工作表中将表格复制5次。然后，它应该再次提示用户询问5个部门中每个部门的百分比份额，并将最后一栏（销售收入）乘以各自的百分比。为了更好地说明我的观点，这里是一个示例工作簿：

Dummy Data on GoogleDrive

关于如何做到这一点有什么建议？

Answer 1

这种方法怎么样 - 当您复制这些值时，用链接到原始范围的公式将最后一列替换为复制列下面的百分比值。允许用户直接在电子表格中修改这些百分比。例如：

Sub test() 
    Dim r As Range, n As Integer, i As Integer, c As Integer 
    Dim vals As Variant 
    Dim cRange As Range 
    Dim pCell As Range 'to hold percentage 
    Dim numRows As Integer, numCols As Integer 
    Dim fcol As String 
    On Error Resume Next 
    Set r = Application.InputBox("Select the range", Type:=8) 
    On Error GoTo 0 
    If r Is Nothing Then Exit Sub 

    numCols = r.Columns.Count 
    numRows = r.Rows.Count 
    vals = r.Value 

    fcol = r.Columns(numCols).Address 
    fcol = "'" & r.Parent.Name & "'!" & fcol 

    n = Application.InputBox("How many departments?") 
    c = ActiveCell.Column 
    Set cRange = Range(ActiveCell, ActiveCell.Offset(numRows - 1, numCols - 1)) 
    For i = 1 To n 
     cRange.Value = vals 
     Set pCell = cRange.Cells(1, 1).Offset(numRows, numCols - 1) 
     pCell.Value = 100 '=100% 
     cRange.Columns(numCols).FormulaArray = "=" & fcol & " * " & "0.01 * " & pCell.Address 
     pCell.Offset(1).Value = "Department " & i & "'s %" 
     Set cRange = cRange.Offset(0, numCols + 1) 
    Next i 

End Sub 

在此代码中，我演示了使用范围对象值属性和变量数组传输数据的标准方法。很少需要在VBA中选择，复制和粘贴