回復 1#jj369963
試試看
1.欄位置入公式
Sub ex()
Dim r As Integer
r = Range("A65535").End(3).Row '計數資料數
[H2].Resize(r - 1) = "=countif($B$2:$D$" & r & ",A2)" '正向次數加總欄放入公式
[I2].Resize(r - 1) = "=countif($E$2:$G$" & r & ",A2)" '負向次數加總欄放入公式
[J2].Resize(r - 1) = "=Standardize(H2, $P$2, $Q$2)" 'LM欄放入公式
[K2].Resize(r - 1) = "=Standardize(I2, $P$2, $Q$2)" 'LL欄放入公式
[L2].Resize(r - 1) = "=Sum(J2:K2)" 'SI欄放入公式
[M2].Resize(r - 1) = "=J2 - K2" 'SP欄放入公式
[N2].Resize(r - 1) = "=IF(AND((J2>0)*(K2<0)*(M2>1)=1),""受歡迎"",IF(AND((J2<0)*(K2>0)*(M2<-1)=1),""被拒絕"",IF(AND((J2<0)*(K2<0)*(L2<-1)=1),""被忽視"",IF(AND((J2>0)*(K2>0)*(L2>1)=1),""受爭議"",IF(AND((M2<1)*(M2>-1)*(L2<1)*(L2>-1)=1),""平均組"")))))" '分類欄放入公式
End Sub
2.直接計算相關數值
Sub ex1()
Dim r, x As Integer
For r = 2 To Range("A65535").End(3).Row
x = 0
'------計算正向次數加總
For Each Rng In Range([B2], [D65535].End(3))
If Cells(r, "a") = Rng Then x = x + 1
Next
Cells(r, "H") = x
x = 0
'------計算負向次數加總
For Each Rng In Range([E2], [G65535].End(3))
If Cells(r, "a") = Rng Then x = x + 1
Next
Cells(r, "I") = x
Next
For r = 2 To Range("A65535").End(3).Row
Cells(r, "J") = WorksheetFunction.Standardize(Cells(r, "H"), Range("P2"), Range("Q2"))
Cells(r, "K") = WorksheetFunction.Standardize(Cells(r, "I"), Range("P2"), Range("Q2"))
Cells(r, "L") = Cells(r, "J") + Cells(r, "K")
Cells(r, "M") = Cells(r, "J") - Cells(r, "K")
If Cells(r, "J") > 0 And Cells(r, "K") < 0 And Cells(r, "M") > 1 Then Cells(r, "N") = "受歡迎"
If Cells(r, "J") > 0 And Cells(r, "K") > 0 And Cells(r, "L") > 1 Then Cells(r, "N") = "受爭議"
If Cells(r, "J") < 0 And Cells(r, "K") > 0 And Cells(r, "M") < -1 Then Cells(r, "N") = "被拒絕"
If Cells(r, "J") < 0 And Cells(r, "K") < 0 And Cells(r, "L") < -1 Then Cells(r, "N") = "被忽視"
If Cells(r, "M") < 1 And Cells(r, "M") > -1 And Cells(r, "L") < 1 And Cells(r, "L") > -1 Then Cells(r, "N") = "平均組"
Next
End Sub
