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

到目前为止这个宏，

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

例如，如果用户输入了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中选择，复制和粘贴

用于为表

1 个答案: