Today I have decided to resolve one of the competition problem of the C# basics exam of the SoftUni (www.softuni.bg) with Excel. I have shown how I have resolved a similar problem in C#, where you should have drawn a glass of wine here. The problem is about building a string, which consists of dots and stars, in a way that it looks like a plane, if you have more phantasy:
For the really curious, I have a pdf version of the exam problem 03.Plane it is licensed under the CC-BY-NC-SA license, so take it in mind, if you redistribute it.
Pretty much what I wanted to achieve is something like this – I wanted to write a custom formula in Excel, with one parameter and to get the output as expected in the example. Did I manage to do it? Check it by yourself:
The question is more or less how I did it. The answer is – following the C# logic and accustoming VBA to my C# knowledge. As far as I did not have a string builder in VBA, I have created a similar function, called fStringBuilder(), taking two arguments – the string which is going to be repeated and the times of repetition. At the end, I have saved everything in the fPlane function, using VbCrLf for spaces. And the i=0 on each line was needed, because this is the way to code in VBA – the for loop is a little … different :). Last but not least, the result should be displayed in a font such as Courier, because it gives each char an equal space. Or simply print it in the immediate window with debug.Print.
Anyway, it is easier to be seen than explained.
At the end I wanted to make it a little bit more fancier, so I have created the sub colorMe(). It colors all the stars Chr(42) into Red. Quite a good one and rather slow actually, but if you look at the code you will realize the reason for the slowness – after all we are printing and this is a scripting language:
Finally, here comes the code – just copy it in a module and use the new fancy function in Excel:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 |
Option Explicit Public Function fPlane(n As Integer) As String Dim iWidth As Integer Dim iHeight As Integer Dim iCount As Integer Dim sStar As String Dim sDot As String Dim i As Integer Dim sResult As String sStar = "*" sDot = "." iWidth = 3 * n iHeight = ((n * 3) - (n / 2)) iCount = 1 i = 0 fPlane = fStringBuilder((iWidth - 1) / 2, sDot) & sStar & fStringBuilder((iWidth - 1) / 2, sDot) & vbCrLf Do While (i < n) If i <= (n / 2 + 1) Then fPlane = fPlane & fStringBuilder((iWidth - 1 - 2 * i) / 2 - 1, sDot) & _ sStar & _ fStringBuilder(1 + 2 * i, sDot) & _ sStar & _ fStringBuilder((iWidth - 1 - 2 * i) / 2 - 1, sDot) & _ vbCrLf Else fPlane = fPlane & fStringBuilder((iWidth - 1 - 2 * i) / 2 - 1 - iCount, sDot) & _ sStar & _ fStringBuilder(1 + 2 * i + 2 * iCount, sDot) & _ sStar & _ fStringBuilder((iWidth - 1 - 2 * i) / 2 - 1 - iCount, sDot) & _ vbCrLf iCount = iCount + 1 End If i = i + 1 Loop fPlane = fPlane & sStar & _ fStringBuilder(n - 2, sDot) & _ sStar & _ fStringBuilder(n, sDot) & _ sStar & _ fStringBuilder(n - 2, sDot) & _ sStar & _ vbCrLf i = 1 Do While (i <= (n / 2) - 1) fPlane = fPlane & sStar & _ fStringBuilder(n - 2 - 2 * i, sDot) & _ sStar & _ fStringBuilder(2 * i - 1, sDot) & _ sStar & _ fStringBuilder(n, sDot) & _ sStar & _ fStringBuilder(2 * i - 1, sDot) & _ sStar & _ fStringBuilder(n - 2 - 2 * i, sDot) & _ sStar & _ vbCrLf i = i + 1 Loop i = 0 Do While (i < n - 1) fPlane = fPlane & fStringBuilder(n - 1 - i, sDot) & _ sStar & _ fStringBuilder(n + 2 * i, sDot) & _ sStar & _ fStringBuilder(n - 1 - i, sDot) & _ vbCrLf i = i + 1 Loop fPlane = fPlane & fStringBuilder(iWidth, sStar) & vbCrLf & "www.vitoshacademy.com" End Function Public Function fStringBuilder(ByVal iTimes As Integer, ByVal sAdded As String) As String fStringBuilder = "" Dim zCounter As Integer For zCounter = 1 To iTimes fStringBuilder = fStringBuilder & sAdded Next End Function Sub colorMe() Dim i As Integer Dim sSearchString As String Dim FindChar As String activecell.Value = CStr(activecell.Value) sSearchString = activecell.Value FindChar = Chr(42) For i = 1 To Len(sSearchString) If Mid(sSearchString, i, 1) = FindChar Then activecell.Characters(i, 1).Font.Color = RGB(255, 0, 0) End If activecell.Characters(i, 1).Font.Bold = True Next i activecell.HorizontalAlignment = xlCenter End Sub |
🙂