將10週期曲線摺疊爲4個週期

Question

我有一個10週期成本曲線表如下。我如何以編程方式摺疊/縮小/縮小爲4個週期。我使用的是VBA，但我應該能夠遵循其他語言。例程應該適用於你傳遞給它的任何時期。例如，如果我通過了7，它應該將百分比濃縮爲7個週期。如果我通過它24，然後將百分比擴大到24個時期，根據原始曲線分攤百分比。任何幫助或例子將不勝感激。謝謝...

 
ORIGINAL 
Period Pct 
1  10.60% 
2  19.00% 
3  18.30% 
4  14.50% 
5  10.70% 
6  8.90% 
7  6.50% 
8  3.10% 
9  3.00% 
10  5.40% 

 
COLLAPSED 
Period Pct 
1  38.75% 
2  34.35% 
3  16.95% 
4  9.95% 

編輯：我已經添加下面的示例代碼，以什麼我迄今。它只適用於期間1,2,3,5,9,10。也許有人可以幫助修改它在任何時期工作。免責聲明，我不是程序員，所以我的代碼不好。另外，我不知道我在做什麼。

 
Sub Collapse_Periods() 
    Dim aPct As Variant 
    Dim aPer As Variant 
    aPct = Array(0.106, 0.19, 0.183, 0.145, 0.107, 0.089, 0.065, 0.031, 0.03, 0.054) 
    aPer = Array(1, 2, 3, 5, 9, 10) 
    For i = 0 To UBound(aPer) 
     pm = 10/aPer(i) 
     pct1 = 1 
     p = 0 
     ttl = 0 
     For j = 1 To aPer(i) 
      pct = 0 
      k = 1 
      Do While k <= pm 
       pct = pct + aPct(p) * pct1 
       pct1 = 1 
       p = p + 1 
       If k <> pm And k = Int(pm) Then 
        pct1 = (pm - Int(pm)) * j 
        pct = pct + (pct1 * aPct(p)) 
        pct1 = 1 - pct1 
       End If 
       k = k + 1 
      Loop 
      Debug.Print aPer(i) & " : " & j & " : " & pct 
      ttl = ttl + pct 
     Next j 
     Debug.Print "Total: " & ttl 
    Next i 
End Sub 

Answer 1

Answer 2

我想知道如何使用積分？這就是我如何做到的 - 也許這是一種長期/長期的方法，但我希望看到一些更好的建議。

在Excel中首先使用LINEST函數和命名範圍來查看該方法可能更容易。我認爲這個函數是對數的。我已經概述的步驟[1] - [5]

然後將該VBA代碼基本上覆制使用函數Excel的方法傳遞2個陣列，週期和可寫入範圍

返回陣列

Sub CallingProc() 
Dim Periods As Long, returnArray() As Variant 
Dim X_Values() As Variant, Y_Values() As Variant 

Periods = 4 
ReDim returnArray(1 To Periods, 1 To 2) 

With Sheet1 
    X_Values = Application.Transpose(.Range("A2:A11")) 
    Y_Values = Application.Transpose(.Range("B2:B11")) 
End With 


FGraph X_Values, Y_Values, Periods, returnArray 'pass 1D array of X, 1D array of Y, Periods, Empty ReturnArray 
End Sub 


Function FGraph(ByVal x As Variant, ByVal y As Variant, ByVal P As Long, ByRef returnArray As Variant) 
Dim i As Long, mConstant As Double, cConstant As Double 

'calc cumulative Y and take Ln (Assumes Form of Graph is logarithmic!!) 
For i = LBound(y) To UBound(y) 
    If i = LBound(y) Then 
     y(i) = y(i) 
    Else 
     y(i) = y(i) + y(i - 1) 
    End If 

    x(i) = Log(x(i)) 
Next i 

'calc line of best fit 
With Application.WorksheetFunction 
    mConstant = .LinEst(y, x)(1) 
    cConstant = .LinEst(y, x)(2) 
End With 

'redim array to fill for new Periods 
ReDim returnArray(1 To P, 1 To 2) 

'Calc new periods based on line of best fit 
For i = LBound(returnArray, 1) To UBound(returnArray, 1) 
    returnArray(i, 1) = UBound(y)/P * i 
    If i = LBound(returnArray, 1) Then 
     returnArray(i, 2) = (Log(returnArray(i, 1)) * mConstant) + cConstant 
    Else 
     returnArray(i, 2) = ((Log(returnArray(i, 1)) * mConstant) + cConstant) - _ 
     ((Log(returnArray(i - 1, 1)) * mConstant) + cConstant) 
    End If 
Next i 

'returnArray can be written to range 

End Function 

編輯：

這VBA代碼現在計算點新時期還原的任一側的線性趨勢。數據在命名returnArray一個2dimension陣列

Sub CallingProc() 
Dim Periods As Long, returnArray() As Variant 
Dim X_Values() As Variant, Y_Values() As Variant 

Periods = 4 
ReDim returnArray(1 To Periods, 1 To 2) 

With Sheet1 
    X_Values = Application.Transpose(.Range("A2:A11")) 
    Y_Values = Application.Transpose(.Range("B2:B11")) 
End With 


FGraph X_Values, Y_Values, returnArray 'pass 1D array of X, 1D array of Y, Dimensioned ReturnArray 
End Sub 


Function FGraph(ByVal x As Variant, ByVal y As Variant, ByRef returnArray As Variant) 
Dim i As Long, j As Long, mConstant As Double, cConstant As Double, Period As Long 

Period = UBound(returnArray, 1) 

'calc cumulative Y 
For i = LBound(y) + 1 To UBound(y) 
     y(i) = y(i) + y(i - 1) 
Next i 

'Calc new periods based on line of best fit 
For i = LBound(returnArray, 1) To UBound(returnArray, 1) 
    returnArray(i, 1) = UBound(y)/Period * i 

     'find position of new period to return adjacent original data points 
     For j = LBound(x) To UBound(x) 
      If returnArray(i, 1) <= x(j) Then Exit For 
     Next j 

     'calc linear line of best fit between existing data points 
     With Application.WorksheetFunction 
      mConstant = .LinEst(Array(y(j), y(j - 1)), Array(x(j), x(j - 1)))(1) 
      cConstant = .LinEst(Array(y(j), y(j - 1)), Array(x(j), x(j - 1)))(2) 
     End With 

     returnArray(i, 2) = (returnArray(i, 1) * mConstant) + cConstant 

Next i 

'returnarray holds cumulative % so calc period only % 
For i = UBound(returnArray, 1) To LBound(returnArray, 1) + 1 Step -1 
    returnArray(i, 2) = returnArray(i, 2) - returnArray(i - 1, 2) 
Next i 

'returnArray now holds your data 

End Function 

返回返回：

COLLAPSED

1 38.75％

2 34.35％

3 16.95％

4 9.95％