[VBA] MEDIANIFS, MODEIFS
Attribute VB_Name = “BB_VBA_API_191106”
‘주어진 조건으로 중간값을 구한다.
‘사용법 : BB_MEDIANIFS(계산대상, [조건범위1], [조건값1], [조건범위2], [조건값2], [조건범위3], [조건값3] …)
Function BB_MEDIANIFS(ParamArray paramArr())
‘에러 발생시 BB_MEDIANIFS_ERROR 레이블로 이동(GoTo)
On Error GoTo BB_MEDIANIFS_ERROR
‘조건에 맞는 범위를 배열 형태로 가져온다. 만약 오류 발생시 오류 메시지를 리턴한다.
Dim resultArr
resultArr = getValuesIfs(paramArr)
If TypeName(resultArr) = “String” Then
BB_MEDIANIFS = resultArr
Exit Function
End If
‘배열 쏘팅
resultArr = sortArray(resultArr)
‘배열 사이즈 가져오기
Dim arrCount
arrCount = getArraySize(resultArr)
‘중간값을 산출한다.
Dim firstIndex
If arrCount Mod 2 = 0 Then
‘배열의 개수가 짝수이면 중간에 위치한 2개의 값을 평균낸다.
firstIndex = (Int(arrCount) / 2) – 1
BB_MEDIANIFS = (CDbl(resultArr(firstIndex)) + CDbl(resultArr(firstIndex + 1))) / 2
Exit Function
Else
‘배열의 개수가 홀수이면 중간에 위치한 1개의 값을 가져온다.
firstIndex = ((Int(arrCount) – 1) / 2)
BB_MEDIANIFS = resultArr(firstIndex)
Exit Function
End If
BB_MEDIANIFS_ERROR:
BB_MEDIANIFS = “[오류] 에러코드 ” & Err.Number & ” 발생 : ” & Err.Description & “”
End Function
‘주어진 조건으로 최빈값을 구한다.
‘사용법 : BB_MODEIFS(계산대상, [조건범위1], [조건값1], [조건범위2], [조건값2], [조건범위3], [조건값3] …)
Function BB_MODEIFS(ParamArray paramArr())
‘에러 발생시 BB_MODEIFS_ERROR 레이블로 이동(GoTo)
On Error GoTo BB_MODEIFS_ERROR
‘조건에 맞는 범위를 배열 형태로 가져온다. 만약 오류 발생시 오류 메시지를 리턴한다.
Dim resultArr
resultArr = getValuesIfs(paramArr)
If TypeName(resultArr) = “String” Then
BB_MODEIFS = resultArr
Exit Function
End If
‘배열 사이즈 가져오기
Dim arrCount
arrCount = getArraySize(resultArr)
Dim lastIndex
lastIndex = arrCount – 1
‘최빈값을 구한다.
Dim maxKey
maxKey = “”
Dim maxCount
maxCount = 0
Dim MyCollection As New Collection
For i = 0 To lastIndex
Dim oneKey
oneKey = resultArr(i) & “”
‘오류 방지를 위해 쉼표를 제거한다.
oneKey = Replace(oneKey, “,”, “”)
Dim newCount
newCount = 0
Dim oldCount
oldCount = 0
On Error Resume Next
oldCount = MyCollection.Item(oneKey)
On Error GoTo 0
If checkIsNumber(oldCount) = True Then
newCount = Int(oldCount) + 1
Else
newCount = 1
End If
On Error Resume Next
MyCollection.Add Item:=newCount, Key:=oneKey
On Error GoTo 0
If maxCount < newCount Then
maxKey = oneKey & “”
maxCount = newCount
ElseIf maxCount = newCount Then
If maxKey <> oneKey And InStr(1, maxKey, ” , ” & oneKey, vbTextCompare) < 1 And InStr(1, maxKey, oneKey & ” , “, vbTextCompare) < 1 Then
maxKey = maxKey & ” , ” & oneKey
End If
End If
Next i
If maxKey = “” Then
BB_MODEIFS = “결과없음”
Else
BB_MODEIFS = maxKey & “(” & maxCount & “회)”
End If
Exit Function
BB_MODEIFS_ERROR:
BB_MODEIFS = “[오류] 에러코드 ” & Err.Number & ” 발생 : ” & Err.Description & “”
End Function
‘getValuesIfs : 조건에 맞는 범위를 배열 형태로 가져온다. 만약 오류 발생시 오류 메시지를 리턴한다.
Private Function getValuesIfs(ByVal paramArr)
‘에러 발생시 getValuesIfs_error 레이블로 이동(GoTo)
On Error GoTo getValuesIfs_error
Dim paramCount
paramCount = 0
Dim param
For Each param In paramArr
paramCount = paramCount + 1
Next
If paramCount < 1 Then
getValuesIfs = “[오류] 인자는 1개 이상이어야 합니다.”
Exit Function
End If
If paramCount Mod 2 = 0 Then
getValuesIfs = “[오류] 인자는 홀수 개여야 합니다.”
Exit Function
End If
‘leftAddr, rightAddr 변수에 문자열을 저장한다. $가 포함되어 있다면 제거한다.
‘ex) 기존값 “$A$1:$D$10” 이라면 각각 “A1”, “D10” 이 된다.
‘ex) 기존값 “$A$1” 이라면 각각 “A1”, “A1” 이 된다.
Dim addr
addr = paramArr(0).Address & “”
addr = Replace(addr, “$”, “”)
Dim leftAddr, leftColNum, leftRowNum
Dim rightAddr, rightColNum, rightRowNum
Dim colonIdx
colonIdx = InStr(addr, “:”)
If colonIdx > 0 Then
‘콜론이 존재하는 경우(다중범위)
leftAddr = Mid(addr, 1, colonIdx – 1)
leftColNum = Range(leftAddr).Column
leftRowNum = Range(leftAddr).Row
rightAddr = Mid(addr, colonIdx + 1, Len(addr) – colonIdx)
rightColNum = Range(rightAddr).Column
rightRowNum = Range(rightAddr).Row
Else
‘콜론이 존재하지 않는 경우(단일범위)
leftAddr = addr
leftColNum = Range(leftAddr).Column
leftRowNum = Range(leftAddr).Row
rightAddr = addr
rightColNum = Range(rightAddr).Column
rightRowNum = Range(rightAddr).Row
End If
If leftColNum <> rightColNum Then
getValuesIfs = “[오류] 1번째 인자의 열 2개가 일치하지 않습니다.”
Exit Function
End If
‘행 계산
Dim minRowNum
minRowNum = leftRowNum
Dim maxRowNum
maxRowNum = rightRowNum
If minRowNum > maxRowNum Then
getValuesIfs = “[오류] 1번째 인자의 행 2개의 순서를 바꿔 입력하여 주십시오.”
Exit Function
End If
‘계산대상(첫번째 인자) 행 개수 세기
Dim rowCount
If (rightRowNum – leftRowNum) > (rightColNum – leftColNum) Then
rowCount = rightRowNum – leftRowNum + 1
Else
rowCount = rightColNum – leftColNum + 1
End If
‘조건개수
Dim condCount
condCount = (paramCount – 1) / 2
‘조건범위배열
Dim condRangeArr
ReDim condRangeArr(condCount)
For i = 0 To condCount – 1
Dim paramIdx
paramIdx = 2 * i + 1
condRangeArr(i) = paramArr(paramIdx).Address & “”
‘달러를 제거한다.
condRangeArr(i) = Replace(condRangeArr(i), “$”, “”)
Dim tmpIdx
tmpIdx = InStr(condRangeArr(i), “:”)
If tmpIdx > 0 Then
‘콜론이 존재하는 경우(다중범위)
Dim tmpLeftCol
Dim tmpLeftRow
tmpLeftCol = Range(Mid(condRangeArr(i), 1, tmpIdx – 1)).Column
tmpLeftRow = Range(Mid(condRangeArr(i), 1, tmpIdx – 1)).Row
Dim tmpRightCol
Dim tmpRightRow
tmpRightCol = Range(Mid(condRangeArr(i), tmpIdx + 1, Len(condRangeArr(i)) – tmpIdx)).Column
tmpRightRow = Range(Mid(condRangeArr(i), tmpIdx + 1, Len(condRangeArr(i)) – tmpIdx)).Row
If tmpLeftCol <> tmpRightCol Then
getValuesIfs = “[오류] ” & (paramIdx + 1) & “번째 인자의 열 2개가 일치하지 않습니다.”
Exit Function
End If
If (tmpRightRow – tmpLeftRow + 1) <> rowCount Then
getValuesIfs = “[오류] 1번째 인자의 행 개수와 ” & (paramIdx + 1) & “번째 인자의 행 개수가 일치하지 않습니다.”
Exit Function
End If
If (tmpLeftRow <> minRowNum) Or (tmpRightRow <> maxRowNum) Then
getValuesIfs = “[오류] 1번째 인자의 행 범위와 ” & (paramIdx + 1) & “번째 인자의 행 범위가 일치하지 않습니다.”
Exit Function
End If
condRangeArr(i) = tmpLeftCol
Else
‘콜론이 존재하지 않는 경우(단일범위)
condRangeArr(i) = Range(condRangeArr(i)).Column
End If
Next i
‘조건값배열
Dim condValArr
ReDim condValArr(condCount)
For i = 0 To condCount – 1
condValArr(i) = paramArr(2 * i + 2)
Next i
‘결과배열
Dim resultArr
ReDim resultArr(rowCount)
‘인덱스
Dim resultIndex
resultIndex = 0
For r = leftRowNum To rightRowNum
For c = leftColNum To rightColNum
targetValue = Cells(r, c).Value
‘대상이 숫자가 아닌 경우 무시한다.
Dim bIsNumber
bIsNumber = checkIsNumber(targetValue)
Dim bAllCondValid
bAllCondValid = True
If bIsNumber = True Then
For k = 0 To condCount – 1
If (Cells(r, condRangeArr(k)).Value & “”) <> (condValArr(k) & “”) Then
bAllCondValid = False
End If
Next k
Else
bAllCondValid = False
End If
If bAllCondValid = True Then
‘MsgBox (bAllCondValid)
‘모든 조건 충족하면 결과배열에 담는다.
resultArr(resultIndex) = targetValue & “”
‘MsgBox (resultIndex & ” ; ” + resultArr(resultIndex))
resultIndex = resultIndex + 1
End If
Next c
Next r
Dim newCount
newCount = resultIndex
Dim newArr
ReDim newArr(newCount)
For i = 0 To (newCount – 1)
newArr(i) = resultArr(i)
Next i
getValuesIfs = newArr
Exit Function
getValuesIfs_error:
getValuesIfs = “[오류] 에러코드 ” & Err.Number & ” 발생 : ” & Err.Description & “”
End Function
‘checkIsNumber : 값이 숫자인지 체크. 마이너스, 마침표, 쉼표까지 숫자로 친다.
Private Function checkIsNumber(str)
str = str & “”
Dim le
le = Len(str)
If le < 1 Then
checkIsNumber = False
Exit Function
End If
Dim ch
For i = 1 To le
ch = Mid(str, i, 1) & “”
If ch <> “0” And ch <> “1” And ch <> “2” And ch <> “3” And ch <> “4” And ch <> “5” And ch <> “6” And ch <> “7” And ch <> “8” And ch <> “9” And ch <> “-” And ch <> “.” And ch <> “,” Then
checkIsNumber = False
Exit Function
End If
Next i
checkIsNumber = True
End Function
‘sortArray : 배열을 쏘팅한다.
Private Function sortArray(arr)
Dim arrCount
arrCount = getArraySize(arr)
Dim arrLastIdx
arrLastIdx = arrCount – 1
For i = 0 To arrLastIdx
For k = i + 1 To arrLastIdx
‘정렬(쏘팅) 조건은 숫자로 한다.
If CDbl(arr(i)) > CDbl(arr(k)) Then
Dim tempVal
tempVal = arr(i) & “”
arr(i) = arr(k) & “”
arr(k) = tempVal & “”
End If
Next k
Next i
‘For i = 0 To arrLastIdx
‘ MsgBox (i & ” : ” & arr(i))
‘Next i
sortArray = arr
End Function
‘getArraySize : 배열 사이즈 가져오기
Private Function getArraySize(arr)
getArraySize = UBound(arr) – LBound(arr)
‘MsgBox (“getArraySize : ” & getArraySize)
End Function