From f4ede652d93c176ff60d0ff1759f6505042c3c59 Mon Sep 17 00:00:00 2001 From: Mohammad S Anwar Date: Tue, 12 Oct 2021 12:23:27 +0100 Subject: - Added guest contributions by Eric Cheung. --- .../eric-cheung/excel-vba/Challenge_134.xlsm | Bin 0 -> 38978 bytes challenge-134/eric-cheung/excel-vba/ch-1.bas | 278 +++++++++++++++++++++ challenge-134/eric-cheung/excel-vba/ch-2.bas | 56 +++++ 3 files changed, 334 insertions(+) create mode 100755 challenge-134/eric-cheung/excel-vba/Challenge_134.xlsm create mode 100755 challenge-134/eric-cheung/excel-vba/ch-1.bas create mode 100755 challenge-134/eric-cheung/excel-vba/ch-2.bas diff --git a/challenge-134/eric-cheung/excel-vba/Challenge_134.xlsm b/challenge-134/eric-cheung/excel-vba/Challenge_134.xlsm new file mode 100755 index 0000000000..bf870aa74a Binary files /dev/null and b/challenge-134/eric-cheung/excel-vba/Challenge_134.xlsm differ diff --git a/challenge-134/eric-cheung/excel-vba/ch-1.bas b/challenge-134/eric-cheung/excel-vba/ch-1.bas new file mode 100755 index 0000000000..cc20f392a3 --- /dev/null +++ b/challenge-134/eric-cheung/excel-vba/ch-1.bas @@ -0,0 +1,278 @@ +Attribute VB_Name = "ModTask_01" +Option Explicit +Option Base 1 +Public Const nBase As Integer = 10 + +Sub myShiftArrayIndx(nArr, nIndx As Integer) + + Dim nIndxSubLoop As Integer + + For nIndxSubLoop = nIndx + 1 To nBase + nArr(nIndxSubLoop - 1) = nArr(nIndxSubLoop) + Next nIndxSubLoop + +End Sub + +Function GetPanDigitalMsg() As String + '' Remarks + '' https://www.geeksforgeeks.org/pandigital-number-given-base/ + + Dim strNum As String + Dim nLoop As Integer, nCnt As Integer + Dim nIndxLoop(1 To nBase) As Integer, nArrIndx(1 To nBase) As Integer, nIntChosen(1 To nBase) As Integer + Dim nBackupArr(1 To nBase, 1 To nBase) As Integer + Dim bFlagArr(1 To nBase) As Boolean + + nCnt = 0 + nIndxLoop(1) = 2 + + Do While nIndxLoop(1) <= nBase + For nLoop = 1 To nBase + nArrIndx(nLoop) = nLoop - 1 ''0 .. 9 + Next nLoop + + nIntChosen(1) = nArrIndx(nIndxLoop(1)) + myShiftArrayIndx nArrIndx, nIndxLoop(1) + + nIndxLoop(2) = 1 + bFlagArr(2) = True + + Do While nIndxLoop(2) <= 9 + If bFlagArr(2) Then + nBackupArr(2, 1) = nArrIndx(nIndxLoop(2)) + nBackupArr(2, 2) = nArrIndx(2) + nBackupArr(2, 3) = nArrIndx(3) + nBackupArr(2, 4) = nArrIndx(4) + nBackupArr(2, 5) = nArrIndx(5) + nBackupArr(2, 6) = nArrIndx(6) + nBackupArr(2, 7) = nArrIndx(7) + nBackupArr(2, 8) = nArrIndx(8) + nBackupArr(2, 9) = nArrIndx(9) + bFlagArr(2) = False + Else + nArrIndx(1) = nBackupArr(2, 1) + nArrIndx(2) = nBackupArr(2, 2) + nArrIndx(3) = nBackupArr(2, 3) + nArrIndx(4) = nBackupArr(2, 4) + nArrIndx(5) = nBackupArr(2, 5) + nArrIndx(6) = nBackupArr(2, 6) + nArrIndx(7) = nBackupArr(2, 7) + nArrIndx(8) = nBackupArr(2, 8) + nArrIndx(9) = nBackupArr(2, 9) + End If + + nIntChosen(2) = nArrIndx(nIndxLoop(2)) + myShiftArrayIndx nArrIndx, nIndxLoop(2) + + nIndxLoop(3) = 1 + bFlagArr(3) = True + + Do While nIndxLoop(3) <= 8 + If bFlagArr(3) Then + nBackupArr(3, 1) = nArrIndx(nIndxLoop(3)) + nBackupArr(3, 2) = nArrIndx(2) + nBackupArr(3, 3) = nArrIndx(3) + nBackupArr(3, 4) = nArrIndx(4) + nBackupArr(3, 5) = nArrIndx(5) + nBackupArr(3, 6) = nArrIndx(6) + nBackupArr(3, 7) = nArrIndx(7) + nBackupArr(3, 8) = nArrIndx(8) + bFlagArr(3) = False + Else + nArrIndx(1) = nBackupArr(3, 1) + nArrIndx(2) = nBackupArr(3, 2) + nArrIndx(3) = nBackupArr(3, 3) + nArrIndx(4) = nBackupArr(3, 4) + nArrIndx(5) = nBackupArr(3, 5) + nArrIndx(6) = nBackupArr(3, 6) + nArrIndx(7) = nBackupArr(3, 7) + nArrIndx(8) = nBackupArr(3, 8) + End If + + nIntChosen(3) = nArrIndx(nIndxLoop(3)) + myShiftArrayIndx nArrIndx, nIndxLoop(3) + + nIndxLoop(4) = 1 + bFlagArr(4) = True + + Do While nIndxLoop(4) <= 7 + If bFlagArr(4) Then + nBackupArr(4, 1) = nArrIndx(nIndxLoop(4)) + nBackupArr(4, 2) = nArrIndx(2) + nBackupArr(4, 3) = nArrIndx(3) + nBackupArr(4, 4) = nArrIndx(4) + nBackupArr(4, 5) = nArrIndx(5) + nBackupArr(4, 6) = nArrIndx(6) + nBackupArr(4, 7) = nArrIndx(7) + bFlagArr(4) = False + Else + nArrIndx(1) = nBackupArr(4, 1) + nArrIndx(2) = nBackupArr(4, 2) + nArrIndx(3) = nBackupArr(4, 3) + nArrIndx(4) = nBackupArr(4, 4) + nArrIndx(5) = nBackupArr(4, 5) + nArrIndx(6) = nBackupArr(4, 6) + nArrIndx(7) = nBackupArr(4, 7) + End If + + nIntChosen(4) = nArrIndx(nIndxLoop(4)) + myShiftArrayIndx nArrIndx, nIndxLoop(4) + + nIndxLoop(5) = 1 + bFlagArr(5) = True + + Do While nIndxLoop(5) <= 6 + If bFlagArr(5) Then + nBackupArr(5, 1) = nArrIndx(nIndxLoop(5)) + nBackupArr(5, 2) = nArrIndx(2) + nBackupArr(5, 3) = nArrIndx(3) + nBackupArr(5, 4) = nArrIndx(4) + nBackupArr(5, 5) = nArrIndx(5) + nBackupArr(5, 6) = nArrIndx(6) + bFlagArr(5) = False + Else + nArrIndx(1) = nBackupArr(5, 1) + nArrIndx(2) = nBackupArr(5, 2) + nArrIndx(3) = nBackupArr(5, 3) + nArrIndx(4) = nBackupArr(5, 4) + nArrIndx(5) = nBackupArr(5, 5) + nArrIndx(6) = nBackupArr(5, 6) + End If + + nIntChosen(5) = nArrIndx(nIndxLoop(5)) + myShiftArrayIndx nArrIndx, nIndxLoop(5) + + nIndxLoop(6) = 1 + bFlagArr(6) = True + + Do While nIndxLoop(6) <= 5 + If bFlagArr(6) Then + nBackupArr(6, 1) = nArrIndx(nIndxLoop(6)) + nBackupArr(6, 2) = nArrIndx(2) + nBackupArr(6, 3) = nArrIndx(3) + nBackupArr(6, 4) = nArrIndx(4) + nBackupArr(6, 5) = nArrIndx(5) + bFlagArr(6) = False + Else + nArrIndx(1) = nBackupArr(6, 1) + nArrIndx(2) = nBackupArr(6, 2) + nArrIndx(3) = nBackupArr(6, 3) + nArrIndx(4) = nBackupArr(6, 4) + nArrIndx(5) = nBackupArr(6, 5) + End If + + nIntChosen(6) = nArrIndx(nIndxLoop(6)) + myShiftArrayIndx nArrIndx, nIndxLoop(6) + + nIndxLoop(7) = 1 + bFlagArr(7) = True + + Do While nIndxLoop(7) <= 4 + If bFlagArr(7) Then + nBackupArr(7, 1) = nArrIndx(nIndxLoop(7)) + nBackupArr(7, 2) = nArrIndx(2) + nBackupArr(7, 3) = nArrIndx(3) + nBackupArr(7, 4) = nArrIndx(4) + bFlagArr(7) = False + Else + nArrIndx(1) = nBackupArr(7, 1) + nArrIndx(2) = nBackupArr(7, 2) + nArrIndx(3) = nBackupArr(7, 3) + nArrIndx(4) = nBackupArr(7, 4) + End If + + nIntChosen(7) = nArrIndx(nIndxLoop(7)) + myShiftArrayIndx nArrIndx, nIndxLoop(7) + + nIndxLoop(8) = 1 + bFlagArr(8) = True + + Do While nIndxLoop(8) <= 3 + If bFlagArr(8) Then + nBackupArr(8, 1) = nArrIndx(nIndxLoop(8)) + nBackupArr(8, 2) = nArrIndx(2) + nBackupArr(8, 3) = nArrIndx(3) + bFlagArr(8) = False + Else + nArrIndx(1) = nBackupArr(8, 1) + nArrIndx(2) = nBackupArr(8, 2) + nArrIndx(3) = nBackupArr(8, 3) + End If + + nIntChosen(8) = nArrIndx(nIndxLoop(8)) + myShiftArrayIndx nArrIndx, nIndxLoop(8) + + nIndxLoop(9) = 1 + bFlagArr(9) = True + + Do While nIndxLoop(9) <= 2 + If bFlagArr(9) Then + nBackupArr(9, 1) = nArrIndx(nIndxLoop(9)) + nBackupArr(9, 2) = nArrIndx(2) + bFlagArr(9) = False + Else + nArrIndx(1) = nBackupArr(9, 1) + nArrIndx(2) = nBackupArr(9, 2) + End If + + nIntChosen(9) = nArrIndx(nIndxLoop(9)) + myShiftArrayIndx nArrIndx, nIndxLoop(9) + + nIndxLoop(10) = 1 + nIntChosen(10) = nArrIndx(nIndxLoop(10)) + + nCnt = nCnt + 1 + + strNum = "" + For nLoop = 1 To nBase + strNum = strNum & nIntChosen(nLoop) + Next nLoop + + If GetPanDigitalMsg <> "" Then + GetPanDigitalMsg = GetPanDigitalMsg & vbNewLine + End If + + GetPanDigitalMsg = GetPanDigitalMsg & strNum + + If nCnt = 5 Then + Exit Function + End If + + nIndxLoop(9) = nIndxLoop(9) + 1 + Loop + + nIndxLoop(8) = nIndxLoop(8) + 1 + Loop + + nIndxLoop(7) = nIndxLoop(7) + 1 + Loop + + nIndxLoop(6) = nIndxLoop(6) + 1 + Loop + + nIndxLoop(5) = nIndxLoop(5) + 1 + Loop + + nIndxLoop(4) = nIndxLoop(4) + 1 + Loop + + nIndxLoop(3) = nIndxLoop(3) + 1 + Loop + + nIndxLoop(2) = nIndxLoop(2) + 1 + Loop + + nIndxLoop(1) = nIndxLoop(1) + 1 + Loop + +End Function + +Sub Task_01() + + Dim strMsg As String + + strMsg = "First 5 Pandigital Numbers in Base 10 are:" & vbNewLine & GetPanDigitalMsg() + + MsgBox strMsg, vbOKOnly, strMyTitle + +End Sub diff --git a/challenge-134/eric-cheung/excel-vba/ch-2.bas b/challenge-134/eric-cheung/excel-vba/ch-2.bas new file mode 100755 index 0000000000..d9aef24c18 --- /dev/null +++ b/challenge-134/eric-cheung/excel-vba/ch-2.bas @@ -0,0 +1,56 @@ +Attribute VB_Name = "ModTask_02" +Option Explicit +Public Const strMyTitle As String = "Eric Cheung" + +Sub Task_02() + + '' Example 01: + '' Const nRowMax As Integer = 3 + '' Const nColMax As Integer = 3 + + '' Example 02: + Const nRowMax As Integer = 3 + Const nColMax As Integer = 5 + + Dim strMsg As String, strUniqCountMsg As String + Dim nMatrixArr(1 To nRowMax, 1 To nColMax) As Integer + Dim nRowLoop As Integer, nColLoop As Integer, nUniqCount As Integer + Dim objDict As Object + + Set objDict = CreateObject("Scripting.Dictionary") + + nUniqCount = 0 + + strMsg = "x |" + + For nColLoop = 1 To nColMax + strMsg = strMsg & " " & nColLoop + Next nColLoop + + strMsg = strMsg & vbNewLine & "--+-----------" + + For nRowLoop = 1 To nRowMax + strMsg = strMsg & vbNewLine & nRowLoop & " |" + For nColLoop = 1 To nColMax + nMatrixArr(nRowLoop, nColLoop) = nRowLoop * nColLoop + strMsg = strMsg & " " & nRowLoop * nColLoop + If Not objDict.exists(nRowLoop * nColLoop) Then + objDict.Add nRowLoop * nColLoop, 1 + If strUniqCountMsg <> "" Then + strUniqCountMsg = strUniqCountMsg & ", " + End If + strUniqCountMsg = strUniqCountMsg & nRowLoop * nColLoop + nUniqCount = nUniqCount + 1 + End If + Next nColLoop + Next nRowLoop + + strUniqCountMsg = "Distinct Terms: " & strUniqCountMsg & vbNewLine & "Count: " & nUniqCount + + strMsg = strMsg & vbNewLine & vbNewLine & strUniqCountMsg + + MsgBox strMsg, vbOKOnly, strMyTitle + + Set objDict = Nothing + +End Sub -- cgit