View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.programming
RB Smissaert RB Smissaert is offline
external usenet poster
 
Posts: 2,452
Default Removing Leading Zeros from a String

In case anybody wanted to test this:

Option Explicit
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private lngStartTime As Long
Private StartTime As Long
Private EndTime As Long

Sub StartTimer()

lngStartTime = timeGetTime()

End Sub

Function EndTimer()

'Get elapsed time in milliseconds
EndTimer = timeGetTime() - lngStartTime

End Function

Function StripLeadingZeros(ByVal strNumber As String) As String

Dim i As Long
Dim byteArray() As Byte

byteArray = strNumber

For i = 0 To UBound(byteArray)
If Not byteArray(i) = 48 Then
If Not byteArray(i) = 0 Then
StripLeadingZeros = Mid(strNumber, i / 2 + 1)
Exit For
End If
End If
Next

End Function

Function StripLeadingZeros2(ByVal strNumber As String) As String

While strNumber Like "0*"
strNumber = Mid(strNumber, 2)
Wend

StripLeadingZeros2 = strNumber

End Function

Private Function StripLeadingZeros3(ByVal strIn As String) As String

Dim n As Integer
Dim strOut As String
Dim boolNonZero As Boolean
Dim cmid As String

For n = 1 To Len(strIn)
cmid = Mid(strIn, n, 1)
Select Case cmid
Case "0":
If boolNonZero Then
strOut = strOut + cmid
End If
Case Else:
strOut = strOut + cmid
boolNonZero = True
End Select
Next n

StripLeadingZeros3 = strOut

End Function


Sub FillTestRange()

Dim c As Range

For Each c In Range(Cells(1), Cells(100, 100))
c = "000000000000456-147-114"
Next

End Sub

Sub teststripping()

Dim c As Range
Dim str As String

StartTimer

For Each c In Range(Cells(1), Cells(100, 100))
str = StripLeadingZeros(c.Text) '155 msecs
'str = StripLeadingZeros2(c.Text) '155 msecs
'str = StripLeadingZeros3(c.Text) '250 msecs
Next

MsgBox EndTimer

End Sub

Sub teststripping2()

Dim arr()
Dim i As Long
Dim c As Long
Dim str As String

arr = Range(Cells(1), Cells(100, 100))

StartTimer

For i = 1 To 100
For c = 1 To 100
'str = StripLeadingZeros(arr(i, c)) '47 msecs
'str = StripLeadingZeros2(arr(i, c)) '47 msecs
str = StripLeadingZeros3(arr(i, c)) '140 msecs
Next
Next

MsgBox EndTimer

End Sub

I will stick with StripLeadingZeros2.


RBS



"keepITcool" wrote in message
...

Your code wont work on non unicode systems (due to step2)

A small change in your code gives 5-10% improvement:
Change: StripLeadingZeros = Right(strNumber, Len(strNumber) - i / 2)
TO : StripLeadingZeros = Mid(strNumber, i / 2)


With an average of less than 4 leading zero's following code is faster:

Function TrimLeadZero$(ByVal strNumber$)
While strNumber Like "0*"
strNumber = Mid(strNumber, 2)
Wend
TrimLeadZero = strNumber
End Function

(I admit it is marginal, and advantage lost with longer strings)

<bg


keepITcool

< email : keepitcool chello nl (with @ and .)
< homepage: http://members.chello.nl/keepitcool


"RB Smissaert" wrote:

If you have a large number of cells to strip you may want the fastest
possible
function. I think this is quite efficient:

Function StripLeadingZeros(strNumber As String) As String

Dim i As Long
Dim byteArray() As Byte

byteArray = strNumber

For i = 0 To UBound(byteArray) Step 2
If Not byteArray(i) = 48 Then
StripLeadingZeros = Right(strNumber, Len(strNumber) - i / 2)
Exit For
End If
Next

End Function

If somebody can show me something that is faster I would be interested.