我有一個包含 1,000 行的電子表格。每行有六個不同權重的列類別（30%、20%、20%、10%、15%、5%），得分為 1、2、3、4、5 或 N/A，然后是編譯總分，所以第一行是 5*.3, 2*.2, 1*.1, 1*.15, 5*.05，一共是 2.4。如果一列有 N/A，我想重新分配值，所以如果價值 30% 的第一列有 N/A，我希望新的剩余五個值的價值為 26%、26%、16%、21% , 11%（是的，我想在每個基礎上增加 6%，而不是根據當前權重重新分配 30%）。如何使用 VBA 代碼執行此操作？如果兩列有 N/A，那么我會將這兩列的總重量分配給其他四列，依此類推。我在這里得到的建議是不要為所有組合做 60 個 if-thens，所以我嘗試通過添加 NA 百分比來處理它，計算 NA，然后將新權重添加到舊權重。我知道最后一個公式本身需要稍微編輯，但我希望能幫助我了解為什么即使 AD2 為 N/A，CatPercentage1 仍為 0，以及如何使這個動態來解釋所有行。謝謝！
Option Explicit
Function NewValue()
End Function
Sub CalculateNewValue()
Dim CatPercentage1 As Single
Dim CatPercentage2 As Single
Dim CatPercentage3 As Single
Dim CatPercentage4 As Single
Dim CatPercentage5 As Single
Dim CatPercentage6 As Single
Dim CatValue1 As Single
Dim CatValue2 As Single
Dim CatValue3 As Single
Dim CatValue4 As Single
Dim CatValue5 As Single
Dim CatValue6 As Single
Dim TotalPercentageNA As Single
Dim NumberNA As Integer
Dim RemainingCat As Integer
Dim AddValue As Single
Dim NewValue As Single
Dim lRow As Long
'lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
'Range("AJ2").AutoFill Range("AJ2:AJ" & lRow)
NumberNA = 0
If Range("AD2") = "N/A" Then
CatPercentage1 = 0.3 And NumberNA = NumberNA 1 And CatValue1 = 0
If Range("AE2") = "N/A" Then
CatPercentage1 = 0.2 And NumberNA = NumberNA 1 And CatValue2 = 0
If Range("AF2") = "N/A" Then
CatPercentage1 = 0.2 And NumberNA = NumberNA 1 And CatValue3 = 0
If Range("AG2") = "N/A" Then
CatPercentage1 = 0.1 And NumberNA = NumberNA 1 And CatValue4 = 0
If Range("AH2") = "N/A" Then
CatPercentage1 = 0.15 And NumberNA = NumberNA 1 And CatValue5 = 0
If Range("AI2") = "N/A" Then
CatPercentage1 = 0.05 And NumberNA = NumberNA 1 And CatValue6 = 0
End If
End If
End If
End If
End If
End If
TotalPercentageNA = (CatPercentage1 CatPercentage2 CatPercentage3 CatPercentage4 CatPercentage5 CatPercentage6)
RemainingCat = 6 - NumberNA
AddValue = TotalPercentageNA / RemainingCat
'MsgBox CatPercentage1
'MsgBox TotalPercentageNA
'MsgBox RemainingCat
'MsgBox NumberNA
'MsgBox AddValue
Range("AJ2").Value = CatValue1 * Range("AE2").Value * (0.3 AddValue) Range("AE2").Value * (0.2 AddValue) Range("AF2").Value * (0.2 AddValue) Range("AG2").Value * (0.1 AddValue) Range("AH2").Value * (0.15 AddValue) Range("AI2").Value * (0.05 AddValue)
End Sub
uj5u.com熱心網友回復：
我希望這有助于解釋并與您期望的結果相匹配：
- SUMIF 計算 N/A 列的百分比
- COUNTIF 對具有值 <> 的列進行計數 N/A
- 將份額添加到所有 6 個“基本”百分比（總數超過 100%，但無關緊要，因為 N/A 列將乘以 0）
- 乘以各自的“新”百分比相關因子，將 N/A 替換為 0；加在一起
編輯：第二行中 8% 的份額只是由于沒有小數的顯示格式，可以更改為例如 2 個小數
uj5u.com熱心網友回復：
這應該接近你所描述的我認為：
Function Weighted(rngVals As Range, rngWeights As Range)
Dim arrVals, arrWeights, numNA As Long, i As Long, arrNA() As Boolean
Dim c As Long, ub As Long, inc As Double, rv As Double
arrWeights = rngWeights.Value 'read weights and values to arrays
arrVals = rngVals.Value
ub = UBound(arrVals, 2) 'how many values
ReDim arrNA(1 To ub) 'for tracking N/A values
For i = 1 To ub 'count of "N/A"
arrNA(i) = arrVals(1, i) = "N/A"
numNA = numNA IIf(arrNA(i), 1, 0) 'increment count?
Next i
If numNA > 0 And numNA < ub Then 'any need to adjust weightings?
For i = 1 To ub
If arrNA(i) Then 'no score: distribute the weighting for this value
inc = (arrWeights(1, i) / (ub - numNA)) 'fraction to distribute
For c = 1 To ub
'only increment used weights
If Not arrNA(c) Then arrWeights(1, c) = arrWeights(1, c) inc
Next c
End If
Next i
End If
'finally calculate the weighted sum
For i = 1 To ub
If Not arrNA(i) Then rv = rv (arrVals(1, i) * arrWeights(1, i))
Next i
Weighted = rv
End Function
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/492089.html