how can this be done? 1

[yehong]

I need to write a function that sets the format of a given number based upon a given Format.For example:
Given format=000.00%
Given number=12345
Then the function should change it to 123.45%
other examples:

Given format Given No. Result
0.0 34 3.4
0,000 1234 1,234
0% 1 1%
0.0000 12345 1.2345
0,000.0000 123 1,234.0000


Any idea how can this be done in VB6.0? Thanks

 

[EBGreen]

I would get each string into an array of chars. Then go down the arrays building a finished string based on what is in the format array but using values from the data array.

[red]"... isn't sanity really just a one trick pony anyway?! I mean, all you get is one trick, rational thinking, but when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick[/red]

 

[yehong]

Can we not do it in a function that accepts two parameters and returns the Result?
Here is what I have done something but it fails in some conditions:

dim decpos as number
dim rdec as string
dim str1 as string
dim str2 as string
dim result as string

str1=0,000.0000
str2=12345

IF Not ("." IN STR1) then
result =str2
end if

If Len(str1)<=1 Then
result =str2
end if
if "." in str1 then
decpos=instr(Trim(str1),".")
rdec=right(str1,Len(str1)-decpos)
result =totext(toNumber(str2),"###."&ReplicateString ("0",Len(rdec)))
end if

if "%" in str1 then
if Len(str1)<=2 Then
result =str2
else

str1=left(str1,Len(str1)-1)
decpos=instr(Trim(str1),".")
rdec=right(str1,Len(str1)-decpos)
result =totext(toNumber(str2),"###."&ReplicateString("0",Len(rdec)))&"%"
end if
end if

if "Text" in str1 Then
result =str2
end if

 

[EBGreen]

Here is what I came up with. It is written in VBScript because I can develop faster in it. It should be easy to vonvert to VB. If I were going to really use this I would need to add some error checking.

Option Explicit

Dim strFormat
Dim strData

WScript.Echo MyFormatter("000.00", "12345")
WScript.Echo MyFormatter("000.00%", "12345")
WScript.Echo MyFormatter("0.0", "12")
WScript.Echo MyFormatter("00", "34")

Function MyFormatter(strFormat, strData)
	Dim arrFormat
	Dim arrData
	Dim strResult
	Dim i
	Dim j
	
	arrFormat = MakeArray(strFormat)
	arrData = MakeArray(strData)
	j=LBound(arrData)
	For i=LBound(arrFormat) To UBound(arrFormat)
		Select Case arrFormat(i)
			Case "."
				strResult = strResult & "."
			Case "%"
				strResult = strResult & "%"
			Case Else
				strResult = strResult & arrData(j)
				j=j+1
		End Select
	Next
	MyFormatter = strResult
End Function

Function MakeArray(strString)
	Dim i
	Dim arrTemp()
	For i=1 To Len(strString)
		ReDim Preserve arrTemp(i - 1)
		arrTemp(i - 1) = Mid(strString, i, 1)
	Next
	MakeArray = arrTemp
End Function

[red]"... isn't sanity really just a one trick pony anyway?! I mean, all you get is one trick, rational thinking, but when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick[/red]

 

[yehong]

Thanks. I will give it a try and let you know how it goes.

 

[yehong]

Thanks, I will give it a try and let you know how it goes.

 

[EBGreen]

I've made some changes to account for ',' and for when fewer data numerals are given than format characters.

[red]"... isn't sanity really just a one trick pony anyway?! I mean, all you get is one trick, rational thinking, but when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick[/red]

 

[EBGreen]

Option Explicit

Dim strFormat
Dim strData

WScript.Echo MyFormatter("000.00", "12345")
WScript.Echo MyFormatter("000.00%", "12345")
WScript.Echo MyFormatter("0.0", "12")
WScript.Echo MyFormatter("00", "34")
WScript.Echo MyFormatter("00.000", "34")
WScript.Echo MyFormatter("000", "34")
WScript.Echo MyFormatter("0,000", "34")
WScript.Echo MyFormatter("0,000.00", "34")

Function MyFormatter(strFormat, strData)
	Dim arrFormat
	Dim arrData
	Dim strResult
	Dim i
	Dim j
	
	arrFormat = MakeArray(strFormat)
	arrData = MakeArray(strData)
	j=LBound(arrData)
	For i=LBound(arrFormat) To UBound(arrFormat)
		Select Case arrFormat(i)
			Case "."
				strResult = strResult & "."
			Case "%"
				strResult = strResult & "%"
			Case ","
				strResult = strResult & ","
			Case Else
				
				If j <= UBound(arrData) Then
					strResult = strResult & arrData(j)
					j=j+1
				Else
					strResult = strResult & arrFormat(i)
				End If
				On Error Goto 0
		End Select
	Next
	MyFormatter = strResult
End Function

Function MakeArray(strString)
	Dim i
	Dim arrTemp()
	For i=1 To Len(strString)
		ReDim Preserve arrTemp(i - 1)
		arrTemp(i - 1) = Mid(strString, i, 1)
	Next
	MakeArray = arrTemp
End Function

[red]"... isn't sanity really just a one trick pony anyway?! I mean, all you get is one trick, rational thinking, but when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick[/red]

 

[yehong]

Hi Tom, here are my test results:

Format Number Expec Result Your fn
0,000.00% 0 0,000.00% 0,000.00%
0,000.000 1.2 1,200.000 1,.20.000
0,000.00% 2.00 2,000.00% 2,.00.00%
0,000.00 2.1 2,100.00 2,.10.00
0,000.000 9 9,000.000 9,000.000

So in above case first and last cases returned correct results. Do you think anything is missing in the formula?

 

[EBGreen]

What you will need to do is to account for when the format string is larger than the data string. There are two things that you can do. One is to stop prcoessing the strings altogether when you hit the end of the data string. In this case you will end up with this situation:
000000.000 1234 => 1234

The second case is to continue processing the format string after you reach the end of the data string and process any special characters (.,%) as well as any zeros after a . In this case you will end up with this situation:
000000.000 1234 => 1234.000

[red]"... isn't sanity really just a one trick pony anyway?! I mean, all you get is one trick, rational thinking, but when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick[/red]

 

[BlackKnight]

Hi,

You could try something like this:

Private Function MyFormat(ByVal Fmt As String, ByVal Number As String) As String

Dim NumberPos As Integer, FmtPos As Integer

If Fmt <> "" And Number <> "" Then
'Break when either string runs out of characters.
Do While NumberPos < Len(Number) And FmtPos < Len(Fmt)
'Get next 0 in format string.
Do While FmtPos <= Len(Fmt)
FmtPos = FmtPos + 1
If Mid$(Fmt, FmtPos, 1) = "0" Then Exit Do
Loop
'Get next number in number string.
Do While NumberPos <= Len(Number)
NumberPos = NumberPos + 1
If Asc(Mid$(Number, NumberPos, 1)) >= 48 And Asc(Mid$(Number, NumberPos, 1)) <= 57 Then Exit Do
Loop
'Assign character.
Mid(Fmt, FmtPos, 1) = Mid(Number, NumberPos, 1)
Loop
End If
MyFormat = Fmt
End Function

Have a good one
BK

 

[yehong]

Thanks BlackKnight. I have slightly modified Toms' solution and it has been working ok but I just noticed one problem that I am getting "Memory Full" error. I think arrays are not clearing up. Tom, any idea where and how should the arrys be cleared?
I have added this line in the MyFormatter function:
strData = Replace(strData, ".", "").
What it does is removes the "." and then the function processes it correctly.

 

[BlackKnight]

Hi,

My solution doesn't need arrays and uses far less code and gives all of the correct results using your test data but to each his own. <g>

Have a good one!
BK