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.