diff options
| author | Mohammad S Anwar <mohammad.anwar@yahoo.com> | 2021-07-20 18:49:24 +0100 |
|---|---|---|
| committer | Mohammad S Anwar <mohammad.anwar@yahoo.com> | 2021-07-20 18:49:24 +0100 |
| commit | 268826bcb6ba3cc51e6639e3c3414e66a0051261 (patch) | |
| tree | 15514bf3ac4e843b43ba1130beea78c9aac12ac4 | |
| parent | 78d8b4e0dd0b06529d9305d7bbfeadb1920006f7 (diff) | |
| download | perlweeklychallenge-club-268826bcb6ba3cc51e6639e3c3414e66a0051261.tar.gz perlweeklychallenge-club-268826bcb6ba3cc51e6639e3c3414e66a0051261.tar.bz2 perlweeklychallenge-club-268826bcb6ba3cc51e6639e3c3414e66a0051261.zip | |
- Added Excel VBA solutions by Eric Cheung.
| -rw-r--r-- | challenge-122/eric-cheung/excel-vba/Challenge_122.xlsm | bin | 0 -> 33234 bytes | |||
| -rw-r--r-- | challenge-122/eric-cheung/excel-vba/ch-1.bas | 48 | ||||
| -rw-r--r-- | challenge-122/eric-cheung/excel-vba/ch-2.bas | 100 |
3 files changed, 148 insertions, 0 deletions
diff --git a/challenge-122/eric-cheung/excel-vba/Challenge_122.xlsm b/challenge-122/eric-cheung/excel-vba/Challenge_122.xlsm Binary files differnew file mode 100644 index 0000000000..f8ade07e60 --- /dev/null +++ b/challenge-122/eric-cheung/excel-vba/Challenge_122.xlsm diff --git a/challenge-122/eric-cheung/excel-vba/ch-1.bas b/challenge-122/eric-cheung/excel-vba/ch-1.bas new file mode 100644 index 0000000000..2b516343a9 --- /dev/null +++ b/challenge-122/eric-cheung/excel-vba/ch-1.bas @@ -0,0 +1,48 @@ +Attribute VB_Name = "ModTask_01"
+Option Explicit
+Option Base 1
+Public Const strMyTitle As String = "Eric Cheung"
+
+Function RunningAvg()
+
+ Dim arrNum
+ Dim nArrCnt As Integer, nLoop As Integer
+ Dim dSum As Double
+ Dim dRunAvgArr() As Double
+
+ arrNum = Array(10, 20, 30, 40, 50, 60, 70, 80, 90)
+
+ nArrCnt = UBound(arrNum) - LBound(arrNum) + 1
+ ReDim dRunAvgArr(1 To nArrCnt)
+
+ For nLoop = 1 To nArrCnt
+ dSum = dSum + arrNum(nLoop)
+ dRunAvgArr(nLoop) = dSum / nLoop
+ Next nLoop
+
+ RunningAvg = dRunAvgArr
+
+End Function
+
+Sub Task_01()
+
+ Dim dRunAvgList
+ Dim strMsg As String
+ Dim nCnt As Integer
+
+ dRunAvgList = RunningAvg()
+
+ strMsg = ""
+
+ For nCnt = LBound(dRunAvgList) To UBound(dRunAvgList)
+ If strMsg <> "" Then
+ strMsg = strMsg & "; "
+ End If
+ strMsg = strMsg & dRunAvgList(nCnt)
+ Next nCnt
+
+ strMsg = "The Running Average List: " & vbNewLine & strMsg
+
+ MsgBox strMsg, vbOKOnly, strMyTitle
+
+End Sub
diff --git a/challenge-122/eric-cheung/excel-vba/ch-2.bas b/challenge-122/eric-cheung/excel-vba/ch-2.bas new file mode 100644 index 0000000000..4e46970a90 --- /dev/null +++ b/challenge-122/eric-cheung/excel-vba/ch-2.bas @@ -0,0 +1,100 @@ +Attribute VB_Name = "ModTask_02"
+Option Explicit
+
+Function GetPntScore(nNum)
+
+ Const nPntMax As Integer = 3
+ Const nPntMin As Integer = 1
+
+ Dim nCntLoop As Integer, nSubLoop As Integer, nTotalCnt As Integer
+ Dim nSum As Integer
+
+ Dim nArrCnt() As Integer, nArrMax() As Integer
+ Dim nResultArr() As Integer
+
+ ReDim nArrCnt(1 To nNum)
+ ReDim nArrMax(1 To nNum)
+ ReDim nResultArr(1 To nNum, 1 To 1)
+
+ '''Initialize
+ nCntLoop = 1
+ nTotalCnt = 0
+
+ nArrCnt(1) = nPntMin
+ nArrMax(1) = nPntMax
+
+ '''Loop
+ Do
+ Do While nArrCnt(nCntLoop) >= nPntMin And nArrCnt(nCntLoop) <= nArrMax(nCntLoop)
+ Do While nCntLoop < nNum
+ nCntLoop = nCntLoop + 1
+
+ nSum = nNum
+ For nSubLoop = 1 To nCntLoop - 1
+ nSum = nSum - nArrCnt(nSubLoop)
+ Next nSubLoop
+
+ nArrCnt(nCntLoop) = Application.Min(1, nSum)
+ nArrMax(nCntLoop) = Application.Max(0, nSum)
+ Loop
+
+ nTotalCnt = nTotalCnt + 1
+ If nTotalCnt > 1 Then
+ ReDim Preserve nResultArr(1 To nNum, 1 To nTotalCnt)
+ End If
+
+ For nSubLoop = 1 To nNum
+ nResultArr(nSubLoop, nTotalCnt) = nArrCnt(nSubLoop)
+ Next nSubLoop
+
+ nArrCnt(nCntLoop) = nArrCnt(nCntLoop) + 1
+ Loop
+
+ nCntLoop = nCntLoop - 1
+ nArrCnt(nCntLoop) = nArrCnt(nCntLoop) + 1
+
+ Loop Until nArrCnt(1) > nPntMax
+
+ GetPntScore = nResultArr
+
+End Function
+
+Sub Task_02()
+
+ Dim arrResult
+ Dim nRowLoop As Integer, nColLoop As Integer
+ Dim strMsg As String, strSubMsg As String
+
+ Dim varInputNum
+
+ Do
+ varInputNum = InputBox("Please enter a number > 0", strMyTitle, 4)
+ If varInputNum = "" Then Exit Sub
+ Loop Until varInputNum > 0
+
+ arrResult = GetPntScore(varInputNum)
+ strMsg = ""
+
+ For nRowLoop = LBound(arrResult, 2) To UBound(arrResult, 2)
+ strSubMsg = ""
+ For nColLoop = LBound(arrResult, 1) To UBound(arrResult, 1)
+ If arrResult(nColLoop, nRowLoop) > 0 Then
+ If strSubMsg <> "" Then
+ strSubMsg = strSubMsg & "; "
+ End If
+ strSubMsg = strSubMsg & arrResult(nColLoop, nRowLoop)
+ End If
+ Next nColLoop
+
+ If strMsg <> "" Then
+ strMsg = strMsg & vbNewLine
+ End If
+ strMsg = strMsg & strSubMsg
+ Next nRowLoop
+
+ strMsg = "The methods are: " & vbNewLine & strMsg
+
+ MsgBox strMsg, vbOKOnly, strMyTitle
+
+End Sub
+
|