|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Option Explicit
- Private Sub ReDistribution()
- Dim aData, aResult, aOutPut()
- Dim nSum&, nMax&, nMin&, nMaxCol&, nMinCol&
- Dim nGap&
- Dim i&, j&
- aData = [A1].CurrentRegion.Value
- aResult = [I1].Resize(UBound(aData, 1), 1).Value
- aOutPut = [I1].Resize(UBound(aData, 1), 8).Value
- For i = 2 To UBound(aData, 1)
- nSum = 0: nMax = 0: nMin = 0
- For j = 3 To 7
- aOutPut(i, j) = Round(aResult(i, 1) * aData(i, j) / aData(i, 2), 0)
- nSum = nSum + aOutPut(i, j)
- If aOutPut(i, j) > nMax Then
- nMax = aOutPut(i, j): nMaxCol = j
- End If
- If nMin = 0 Then
- nMin = aOutPut(i, j): nMinCol = j
- ElseIf aOutPut(i, j) < nMin Then
- nMin = aOutPut(i, j): nMinCol = j
- End If
- Next
- If nSum > aResult(i, 1) Then
- nGap = nSum - aResult(i, 1)
- aOutPut(i, nMaxCol) = aOutPut(i, nMaxCol) - nGap
- aOutPut(i, 8) = nSum - nGap
- ElseIf nSum < aResult(i, 1) Then
- nGap = aResult(i, 1) - nSum
- aOutPut(i, nMinCol) = aOutPut(i, nMinCol) + nGap
- aOutPut(i, 8) = nSum + nGap
- End If
- Next
- [I1].Resize(UBound(aData, 1), 8).Value = aOutPut
- End Sub
复制代码 |
|