diff options
| author | Mohammad S Anwar <mohammad.anwar@yahoo.com> | 2021-08-07 01:47:53 +0100 |
|---|---|---|
| committer | Mohammad S Anwar <mohammad.anwar@yahoo.com> | 2021-08-07 01:47:53 +0100 |
| commit | ba82340b5eb96df1c84692393dd733046ed74ed9 (patch) | |
| tree | d29e824eada144d1e499824ec668bf9dee7196ce /challenge-124/eric-cheung | |
| parent | ce45fdeb454766aca81fd0b3eec22ef8d9fe52dd (diff) | |
| download | perlweeklychallenge-club-ba82340b5eb96df1c84692393dd733046ed74ed9.tar.gz perlweeklychallenge-club-ba82340b5eb96df1c84692393dd733046ed74ed9.tar.bz2 perlweeklychallenge-club-ba82340b5eb96df1c84692393dd733046ed74ed9.zip | |
- Added guest contributions by Eric Cheung.
Diffstat (limited to 'challenge-124/eric-cheung')
| -rw-r--r-- | challenge-124/eric-cheung/excel-vba/Challenge_124.xlsm | bin | 0 -> 33111 bytes | |||
| -rw-r--r-- | challenge-124/eric-cheung/excel-vba/ch-1.bas | 29 | ||||
| -rw-r--r-- | challenge-124/eric-cheung/excel-vba/ch-2.bas | 127 |
3 files changed, 156 insertions, 0 deletions
diff --git a/challenge-124/eric-cheung/excel-vba/Challenge_124.xlsm b/challenge-124/eric-cheung/excel-vba/Challenge_124.xlsm Binary files differnew file mode 100644 index 0000000000..fbf9b17e23 --- /dev/null +++ b/challenge-124/eric-cheung/excel-vba/Challenge_124.xlsm diff --git a/challenge-124/eric-cheung/excel-vba/ch-1.bas b/challenge-124/eric-cheung/excel-vba/ch-1.bas new file mode 100644 index 0000000000..074090707b --- /dev/null +++ b/challenge-124/eric-cheung/excel-vba/ch-1.bas @@ -0,0 +1,29 @@ +Attribute VB_Name = "ModTask_01"
+Option Explicit
+Public Const strMyTitle As String = "Eric Cheung"
+
+Sub Task_01()
+
+ Dim strMsg As String
+
+ strMsg = " ^^^^^"
+ strMsg = strMsg & vbNewLine & " ^ ^"
+ strMsg = strMsg & vbNewLine & " ^ ^"
+ strMsg = strMsg & vbNewLine & " ^ ^"
+ strMsg = strMsg & vbNewLine & "^ ^"
+ strMsg = strMsg & vbNewLine & "^ ^"
+ strMsg = strMsg & vbNewLine & "^ ^"
+ strMsg = strMsg & vbNewLine & "^ ^"
+ strMsg = strMsg & vbNewLine & "^ ^"
+ strMsg = strMsg & vbNewLine & " ^ ^"
+ strMsg = strMsg & vbNewLine & " ^^^^^"
+ strMsg = strMsg & vbNewLine & " ^"
+ strMsg = strMsg & vbNewLine & " ^"
+ strMsg = strMsg & vbNewLine & " ^"
+ strMsg = strMsg & vbNewLine & " ^^^^^"
+ strMsg = strMsg & vbNewLine & " ^"
+ strMsg = strMsg & vbNewLine & " ^"
+
+ MsgBox strMsg, vbOKOnly, strMyTitle
+
+End Sub
diff --git a/challenge-124/eric-cheung/excel-vba/ch-2.bas b/challenge-124/eric-cheung/excel-vba/ch-2.bas new file mode 100644 index 0000000000..695e46b6aa --- /dev/null +++ b/challenge-124/eric-cheung/excel-vba/ch-2.bas @@ -0,0 +1,127 @@ +Attribute VB_Name = "ModTask_02"
+Option Explicit
+Option Base 1
+
+Sub Task_02()
+
+ Const nPntMin As Integer = 1
+
+ Dim nArrSet As Variant
+ Dim nCntLoop As Integer, nLoop As Integer, nSubLoop As Integer
+ Dim nSubSetMaxLimit_01 As Integer, nSubSetMaxLimit_02 As Integer, nMaxLimit As Integer
+ Dim nSetTotal As Integer, nSubSetTotal_01 As Integer, nSubSetTotal_02 As Integer
+ Dim nSetAbsDiff As Integer, nSetLoopAbsDiff As Integer
+ Dim bFlag As Boolean
+ Dim wsFunc As Object
+ Dim strMsg As String
+
+ Dim nArrCnt() As Integer, nArrSet_01() As Integer, nArrSet_02() As Integer
+ Dim bFlagArr() As Boolean
+
+ Set wsFunc = Application.WorksheetFunction
+
+ nArrSet = Array(10, 20, 30, 40, 50, 60, 70, 80, 90, 100)
+ ''nArrSet = Array(10, -15, 20, 30, -25, 0, 5, 40, -5)
+
+ nSetTotal = wsFunc.Sum(nArrSet)
+ nSetAbsDiff = nSetTotal
+
+ nMaxLimit = UBound(nArrSet) - LBound(nArrSet) + 1
+ If nMaxLimit Mod 2 = 0 Then
+ nSubSetMaxLimit_01 = nMaxLimit / 2
+ nSubSetMaxLimit_02 = nMaxLimit / 2
+ Else
+ nSubSetMaxLimit_01 = (nMaxLimit - 1) / 2
+ nSubSetMaxLimit_02 = (nMaxLimit + 1) / 2
+ End If
+
+ ReDim bFlagArr(1 To nMaxLimit)
+
+ ReDim nArrCnt(1 To nSubSetMaxLimit_01)
+ ReDim nArrSet_01(1 To nSubSetMaxLimit_01)
+ ReDim nArrSet_02(1 To nSubSetMaxLimit_02)
+
+ '''Initialize
+ nCntLoop = 1
+
+ nArrCnt(1) = nPntMin
+
+ '''Loop
+ Do
+ Do While nArrCnt(nCntLoop) >= nPntMin And nArrCnt(nCntLoop) <= nMaxLimit
+ Do While nCntLoop < nSubSetMaxLimit_01
+ nCntLoop = nCntLoop + 1
+ nArrCnt(nCntLoop) = nArrCnt(nCntLoop - 1) + 1
+ Loop
+
+ bFlag = True
+ For nLoop = 1 To nSubSetMaxLimit_01
+ If nArrCnt(nLoop) > nMaxLimit Then
+ bFlag = False
+ Exit For
+ End If
+ Next nLoop
+
+ If bFlag Then
+ For nLoop = 1 To nMaxLimit
+ bFlagArr(nLoop) = False
+ Next nLoop
+
+ nSubSetTotal_01 = 0
+ For nLoop = 1 To nSubSetMaxLimit_01
+ nSubSetTotal_01 = nSubSetTotal_01 + nArrSet(nArrCnt(nLoop))
+ Next nLoop
+
+ nSubSetTotal_02 = nSetTotal - nSubSetTotal_01
+
+ nSetLoopAbsDiff = Abs(nSubSetTotal_01 - nSubSetTotal_02)
+
+ If nSetLoopAbsDiff < nSetAbsDiff Then
+ nSetAbsDiff = nSetLoopAbsDiff
+ For nLoop = 1 To nSubSetMaxLimit_01
+ nArrSet_01(nLoop) = nArrSet(nArrCnt(nLoop))
+ bFlagArr(nArrCnt(nLoop)) = True
+ Next nLoop
+
+ nSubLoop = 1
+ For nLoop = 1 To nMaxLimit
+ If Not bFlagArr(nLoop) Then
+ nArrSet_02(nSubLoop) = nArrSet(nLoop)
+ nSubLoop = nSubLoop + 1
+ End If
+ Next nLoop
+ End If
+ End If
+
+ nArrCnt(nCntLoop) = nArrCnt(nCntLoop) + 1
+ Loop
+
+ nCntLoop = nCntLoop - 1
+ nArrCnt(nCntLoop) = nArrCnt(nCntLoop) + 1
+
+ Loop Until nArrCnt(1) > nMaxLimit
+
+ strMsg = "Output 1: "
+ For nLoop = LBound(nArrSet_01) To UBound(nArrSet_01)
+ If nLoop > LBound(nArrSet_01) Then
+ strMsg = strMsg & ","
+ End If
+ strMsg = strMsg & " " & nArrSet_01(nLoop)
+ Next nLoop
+
+ strMsg = strMsg & vbNewLine
+ strMsg = strMsg & "Output 2: "
+
+ For nLoop = LBound(nArrSet_02) To UBound(nArrSet_02)
+ If nLoop > LBound(nArrSet_02) Then
+ strMsg = strMsg & ","
+ End If
+ strMsg = strMsg & " " & nArrSet_02(nLoop)
+ Next nLoop
+
+ MsgBox strMsg, vbOKOnly, strMyTitle
+
+ Set wsFunc = Nothing
+
+End Sub
+
|