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中選擇，複製和粘貼