diff options
| author | Mohammad S Anwar <mohammad.anwar@yahoo.com> | 2021-12-01 20:29:58 +0000 |
|---|---|---|
| committer | Mohammad S Anwar <mohammad.anwar@yahoo.com> | 2021-12-01 20:29:58 +0000 |
| commit | 4d52f1a3de425bab672261c2e4233b035d1d1e5f (patch) | |
| tree | 0b3925e0bb5d74fa21aa0391dcebf5ad4ed09fc7 | |
| parent | 2464df08f2262b5575fbaab402d91b9e9310704a (diff) | |
| download | perlweeklychallenge-club-4d52f1a3de425bab672261c2e4233b035d1d1e5f.tar.gz perlweeklychallenge-club-4d52f1a3de425bab672261c2e4233b035d1d1e5f.tar.bz2 perlweeklychallenge-club-4d52f1a3de425bab672261c2e4233b035d1d1e5f.zip | |
- Added guest contributions by Eric Cheung.
| -rwxr-xr-x | challenge-141/eric-cheung/excel-vba/Challenge_141.xlsm | bin | 0 -> 37342 bytes | |||
| -rwxr-xr-x | challenge-141/eric-cheung/excel-vba/ch-1.bas | 93 | ||||
| -rwxr-xr-x | challenge-141/eric-cheung/excel-vba/ch-2.bas | 91 |
3 files changed, 184 insertions, 0 deletions
diff --git a/challenge-141/eric-cheung/excel-vba/Challenge_141.xlsm b/challenge-141/eric-cheung/excel-vba/Challenge_141.xlsm Binary files differnew file mode 100755 index 0000000000..e4d3b2dd01 --- /dev/null +++ b/challenge-141/eric-cheung/excel-vba/Challenge_141.xlsm diff --git a/challenge-141/eric-cheung/excel-vba/ch-1.bas b/challenge-141/eric-cheung/excel-vba/ch-1.bas new file mode 100755 index 0000000000..a743816180 --- /dev/null +++ b/challenge-141/eric-cheung/excel-vba/ch-1.bas @@ -0,0 +1,93 @@ +Attribute VB_Name = "ModTask_01"
+Option Explicit
+
+Public Const strMyTitle As String = "Eric Cheung"
+
+Option Base 1
+Public nPrimeArr() As Long
+Public nPrimePow() As Long
+
+Function IsPrime(nInput As Long) As Boolean
+
+ Dim nNumLoop As Integer, nTempInt As Long
+ Dim bFlag As Boolean
+
+ bFlag = False
+
+ For nNumLoop = LBound(nPrimeArr) To UBound(nPrimeArr)
+ nPrimePow(nNumLoop) = 0
+ Next nNumLoop
+
+ nNumLoop = LBound(nPrimeArr)
+ nTempInt = nInput
+
+ Do While nNumLoop <= UBound(nPrimeArr)
+ If nTempInt Mod nPrimeArr(nNumLoop) = 0 Then
+ nTempInt = nTempInt / nPrimeArr(nNumLoop)
+ nPrimePow(nNumLoop) = nPrimePow(nNumLoop) + 1
+ bFlag = True
+ Else
+ nNumLoop = nNumLoop + 1
+ End If
+ Loop
+
+ If bFlag Then
+ IsPrime = False
+ Else
+ IsPrime = True
+ End If
+
+End Function
+
+Function CountNumFactor() As Integer
+
+ Dim nNumLoop As Integer
+ CountNumFactor = 1
+
+ For nNumLoop = LBound(nPrimePow) To UBound(nPrimePow)
+ CountNumFactor = CountNumFactor * (nPrimePow(nNumLoop) + 1)
+ Next nNumLoop
+
+End Function
+
+Sub Task_01()
+
+ Const nNumDiv As Integer = 8
+
+ Dim strMsg As String
+ Dim nLoop As Long, nCnt As Integer, nPrimeCnt As Long
+
+ ReDim nPrimeArr(1 To 1)
+ ReDim nPrimePow(1 To 1)
+
+ nPrimeCnt = 1
+ nPrimeArr(1) = 2
+
+ nLoop = 3
+ nCnt = 0
+
+ Do While (nCnt < 10)
+ If Not IsPrime(nLoop) Then
+ If CountNumFactor() = nNumDiv Then
+ If strMsg <> "" Then
+ strMsg = strMsg & ", "
+ End If
+ strMsg = strMsg & nLoop
+ nCnt = nCnt + 1
+ End If
+ Else
+ nPrimeCnt = nPrimeCnt + 1
+ ReDim Preserve nPrimeArr(1 To nPrimeCnt)
+ ReDim nPrimePow(1 To nPrimeCnt)
+ nPrimeArr(nPrimeCnt) = nLoop
+ End If
+ nLoop = nLoop + 1
+ Loop
+
+ strMsg = "First 10 positive integers having exactly " & nNumDiv & " divisors are: " & strMsg
+
+ MsgBox strMsg, vbOKOnly, strMyTitle
+
+End Sub
+
+
diff --git a/challenge-141/eric-cheung/excel-vba/ch-2.bas b/challenge-141/eric-cheung/excel-vba/ch-2.bas new file mode 100755 index 0000000000..a19becb4a4 --- /dev/null +++ b/challenge-141/eric-cheung/excel-vba/ch-2.bas @@ -0,0 +1,91 @@ +Attribute VB_Name = "ModTask_02"
+Option Explicit
+Public nNumCand() As Integer
+Public nCount As Integer
+
+Public Sub PerfCombination(ByRef nArrPool() As Integer, ByVal nNumElem As Integer)
+
+ '' Credit: https://stackoverflow.com/questions/7198154/combination-algorithm-in-excel-vba
+
+ Dim nTempIndx As Integer
+ Dim nRowLoop As Integer, nColLoop As Integer
+ Dim strTempNum As String
+
+ nTempIndx = UBound(nArrPool) - LBound(nArrPool) + 1
+
+ Dim nArrIndx() As Integer
+ ReDim nArrIndx(1 To nNumElem)
+
+ For nRowLoop = 1 To nNumElem
+ nArrIndx(nRowLoop) = nRowLoop
+ Next nRowLoop
+
+ Do
+ nCount = nCount + 1
+ If nCount > 1 Then
+ ReDim Preserve nNumCand(1 To nCount)
+ End If
+
+ strTempNum = ""
+
+ For nColLoop = 1 To nNumElem
+ strTempNum = strTempNum & CStr(nArrPool(nArrIndx(nColLoop)))
+ Next nColLoop
+
+ nNumCand(nCount) = Int(strTempNum)
+
+ nRowLoop = nNumElem
+ Do While nArrIndx(nRowLoop) = nTempIndx - nNumElem + nRowLoop
+ nRowLoop = nRowLoop - 1
+ If nRowLoop = 0 Then Exit Sub
+ Loop
+
+ nArrIndx(nRowLoop) = nArrIndx(nRowLoop) + 1
+
+ For nColLoop = nRowLoop + 1 To nNumElem
+ nArrIndx(nColLoop) = nArrIndx(nRowLoop) + nColLoop - nRowLoop
+ Next nColLoop
+ Loop While True
+
+End Sub
+
+Sub Task_02()
+
+ '' Example 1
+ '' Const nNumInput As Integer = 1234
+ '' Const nDiv As Integer = 2
+
+ '' Example 2
+ Const nNumInput As Integer = 768
+ Const nDiv As Integer = 4
+
+ Dim nArr() As Integer
+ Dim nLoop As Integer
+
+ Dim strMsg As String
+
+ ReDim nArr(1 To Len(CStr(nNumInput)))
+
+ ReDim nNumCand(1 To 1)
+ nCount = 0
+
+ For nLoop = 1 To Len(CStr(nNumInput))
+ nArr(nLoop) = Int(Mid(nNumInput, nLoop, 1))
+ Next nLoop
+
+ For nLoop = 1 To Len(CStr(nNumInput)) - 1
+ PerfCombination nArr, nLoop
+ Next nLoop
+
+ For nLoop = LBound(nNumCand) To UBound(nNumCand)
+ If nNumCand(nLoop) Mod nDiv = 0 Then
+ If strMsg <> "" Then
+ strMsg = strMsg & ", "
+ End If
+ strMsg = strMsg & nNumCand(nLoop)
+ End If
+ Next nLoop
+
+ MsgBox strMsg, vbOKOnly, strMyTitle
+
+End Sub
|