88 lines
4.9 KiB
VB.net
88 lines
4.9 KiB
VB.net
Function GetCol(headerName As String, ws As Worksheet) As Long
|
|
Dim lastCol As Long
|
|
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
|
|
On Error Resume Next
|
|
Dim m As Variant
|
|
m = Application.Match(headerName, ws.Range(ws.Cells(1, 1), ws.Cells(1, lastCol)), 0)
|
|
On Error GoTo 0
|
|
If IsError(m) Then
|
|
GetCol = 0
|
|
Else
|
|
GetCol = CLng(m)
|
|
End If
|
|
End Function
|
|
|
|
Sub brierVARS()
|
|
Dim false_vars As Variant
|
|
Dim true_vars As Variant
|
|
false_vars = Array("moza_55_F_1", "moza_55_CON", "demo_15_F_1", "demo_15_CON", "hume_35_F_1", "hume_35_CON", "gulf_15_F_1", "gulf_15_CON", "memo_75_F_1", "memo_75_CON", "vitc_55_F_1", "vitc_55_CON", "hert_35_F_1", "hert_35_CON", "gees_55_F_1", "gees_55_CON", "gang_15_F_1", "gang_15_CON", "list_75_F_1", "list_75_CON", "mont_35_F_1", "mont_35_CON", "dwar_55_F_1", "dwar_55_CON", "pucc_15_F_1", "pucc_15_CON", "spee_75_F_1", "spee_75_CON", "lute_35_F_1", "lute_35_CON")
|
|
true_vars = Array("vaud_15_T_1", "vaud_15_CON", "oedi_35_T_1", "oedi_35_CON", "mons_55_T_1", "mons_55_CON", "gest_75_T_1", "gest_75_CON", "kabu_15_T_1", "kabu_15_CON", "sham_55_T_1", "sham_55_CON", "pana_35_T_1", "pana_35_CON", "bohr_15_T_1", "bohr_15_CON", "chur_75_T_1", "chur_75_CON", "carb_35_T_1", "carb_35_CON", "cons_55_T_1", "cons_55_CON", "papy_75_T_1", "papy_75_CON", "dors_55_T_1", "dors_55_CON", "tsun_75_T_1", "tsun_75_CON", "troy_15_T_1", "troy_15_CON", "lock_35_T_1", "lock_35_CON")
|
|
Dim target_headers As Variant
|
|
target_headers = Array("gest_T_ex", "dors_T_ex", "chur_T_ex", "mons_T_ex", "lock_T_easy", "hume_F_easy", "papy_T_easy", "sham_T_easy", "list_F_easy", "cons_T_easy", "tsun_T_easy", "pana_T_easy", "kabu_T_easy", "gulf_F_easy", "oedi_T_easy", "vaud_T_easy", "mont_F_easy", "demo_F_easy", "spee_F_hard", "dwar_F_hard", "carb_T_hard", "bohr_T_hard", "gang_F_hard", "vitc_F_hard", "hert_F_hard", "pucc_F_hard", "troy_T_hard", "moza_F_hard", "croc_F_hard", "gees_F_hard", "lute_F_hard", "memo_F_hard")
|
|
Dim ws As Worksheet
|
|
Set ws = ThisWorkbook.Sheets(1)
|
|
Dim i As Long, rowCount As Long, colSource1 As Long, colSourceCON As Long, colTarget As Long
|
|
Dim srcVar As String, matchPrefix As String, checkVal As String, val As Double
|
|
Dim result As Variant
|
|
Dim r As Long, j As Long
|
|
rowCount = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
|
|
For i = 0 To UBound(false_vars) Step 2
|
|
srcVar = false_vars(i)
|
|
matchPrefix = Left(srcVar, InStrRev(srcVar, "_") - 1)
|
|
colSource1 = GetCol(srcVar, ws)
|
|
colSourceCON = GetCol(false_vars(i + 1), ws)
|
|
If colSource1 > 0 And colSourceCON > 0 Then
|
|
For r = 2 To rowCount
|
|
checkVal = ws.Cells(r, colSource1).Value
|
|
val = ws.Cells(r, colSourceCON).Value
|
|
colTarget = 0
|
|
For j = 0 To UBound(target_headers)
|
|
If Left(target_headers(j), InStr(target_headers(j), "_") - 1) = Left(matchPrefix, InStr(matchPrefix, "_") - 1) Then
|
|
colTarget = GetCol(target_headers(j), ws)
|
|
Exit For
|
|
End If
|
|
Next j
|
|
If colTarget > 0 Then
|
|
If checkVal = "TRUE" Then
|
|
result = ((val / 100) - 0) ^ 2
|
|
ElseIf checkVal = "FALSE" Then
|
|
result = ((1 - (val / 100)) - 0) ^ 2
|
|
Else
|
|
result = CVErr(xlErrNA)
|
|
End If
|
|
ws.Cells(r, colTarget).Value = result
|
|
End If
|
|
Next r
|
|
End If
|
|
Next i
|
|
For i = 0 To UBound(true_vars) Step 2
|
|
srcVar = true_vars(i)
|
|
matchPrefix = Left(srcVar, InStrRev(srcVar, "_") - 1)
|
|
colSource1 = GetCol(srcVar, ws)
|
|
colSourceCON = GetCol(true_vars(i + 1), ws)
|
|
If colSource1 > 0 And colSourceCON > 0 Then
|
|
For r = 2 To rowCount
|
|
checkVal = ws.Cells(r, colSource1).Value
|
|
val = ws.Cells(r, colSourceCON).Value
|
|
colTarget = 0
|
|
For j = 0 To UBound(target_headers)
|
|
If Left(target_headers(j), InStr(target_headers(j), "_") - 1) = Left(matchPrefix, InStr(matchPrefix, "_") - 1) Then
|
|
colTarget = GetCol(target_headers(j), ws)
|
|
Exit For
|
|
End If
|
|
Next j
|
|
If colTarget > 0 Then
|
|
If checkVal = "TRUE" Then
|
|
result = ((val / 100) - 1) ^ 2
|
|
ElseIf checkVal = "FALSE" Then
|
|
result = ((1 - (val / 100)) - 1) ^ 2
|
|
Else
|
|
result = CVErr(xlErrNA)
|
|
End If
|
|
ws.Cells(r, colTarget).Value = result
|
|
End If
|
|
Next r
|
|
End If
|
|
Next i
|
|
End Sub
|