' note that this code only demonsatrates the technique
' therefore, it only crunches up the results
' handling of results is left to the three peripheral subs which can be easily modified to suit user's need
' I normally avoid using global variables.
' However, in this case hey present the best way to handle the use of peripheral subs
Private resArr() As String, numEl As Long
Sub NhetCham(ByVal s As String)
Dim sArr() As String
Dim ln As Integer, el As Integer
PrepareResultset
AddToResultset s ' first entry, the string itself, no dots
ln = Len(s)
If ln <= 1 Then GoTo Wrap_Up
ReDim sArr(1 To ln * 2 - 1)
For el = 1 To ln ' copy each character of string to odd position in array
sArr(el * 2 - 1) = Mid(s, el, 1)
Next el
ln = UBound(sArr) - 1 ' ln is now the last even position in array
Do ' start building the rest of the resultset
' the following code simulates the action of adding 1 to an integer
' that is, 1+0 is 1; 1+1 is 0 plus 1 carried to the next digit
' simulation procedure: starting from left most, inspect the element
' if the emement is a dot, turn it to a blank and repeat with the next element
' if the elenemt is a blank, turn it to a dot and exit
el = 0
Do
el = el + 2 ' our values are even-positioned elements of the array
If el > ln Then Exit Do ' can not carry any further
If sArr(el) = "" Then
sArr(el) = "."
Exit Do
End If
sArr(el) = ""
Loop
If el > ln Then Exit Do ' no more
AddToResultset Join(sArr, "") ' add current result
Loop
Wrap_Up:
PresentResultset
End Sub
Sub NhetCham2(ByVal s As String)
Dim sArr() As String
Dim ln As Integer, el As Integer, num As Long
PrepareResultset
ln = Len(s)
If ln < 1 Then GoTo Wrap_Up
ReDim sArr(1 To ln * 2 - 1)
For el = 1 To ln ' copy each character of string to odd position in array
sArr(el * 2 - 1) = Mid(s, el, 1)
Next el
For num = 0 To 2 ^ (ln - 1) - 1
For el = 0 To ln - 2
sArr((el + 1) * 2) = IIf(num And 2 ^ el, ".", "")
Next el
AddToResultset Join(sArr, "") ' add current result
Next num
Wrap_Up:
PresentResultset
End Sub
Sub PrepareResultset()
numEl = 0
ReDim resArr(1 To 60000)
End Sub
Sub AddToResultset(ByVal s As String)
numEl = numEl + 1
resArr(numEl) = s
End Sub
Sub PresentResultset()
Dim i As Long
For i = 1 To numEl
Range("A" & i) = resArr(i)
Next i
End Sub
