Hello,
In REXX, I can create a specified number (92 in this example) of hyphens like this:
COPIES('-',92)
Is there an equivalent function in VB ?
Thanks...
Printable View
Hello,
In REXX, I can create a specified number (92 in this example) of hyphens like this:
COPIES('-',92)
Is there an equivalent function in VB ?
Thanks...
Dim s As String
s = String(92, "-")
Here is a function that works just like String$ function, but you can pass strings longer than 1 character:Code:Public Function Replicate(ByVal Count As Long, ByRef Text As String) As String
If Len(Text) > 1 Then
If Count > 1 Then
Replicate = Space$(Len(Text) * Count)
Mid$(Replicate, 1, Len(Text)) = Text
Mid$(Replicate, Len(Text) + 1) = Replicate
ElseIf Count = 1 Then
Replicate = Text
End If
Else
Replicate = String$(Count, Text)
End If
End Function
Check this out for multiple identical strings (92 Johns, in this case):
Code:Private Sub Command1_Click()
Dim MyString As String
MyString = Replace(Space$(92), " ", "John")
MsgBox MyString
End Sub
Code Doc, you forgot one of your own thread of more than 7 months ago, so you went back to the slowest (but shortest) method.
http://www.vbforums.com/showthread.php?t=524574
Merri and other experts also had big contributions in that thread.
Oddly enough, the code I posted here is not featured in that thread :) I didn't know about Mid$'s native replication ability at that time. And it is just as fast as Logophobic's CopyMemory method.
Edit!
Experience is a weird thing. I downloaded the benchmark from the thread linked by anhn and wrote a new optimized code using the new things that I've picked up within the past year:anhn: 0,73281Code:Option Explicit
Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal Ptr As Long, ByVal Length As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)
Public Function Merri(ByVal Count As Long, ByRef Text As String) As String
Dim lngLen As Long
lngLen = LenB(Text)
If lngLen Then
If Count > 1 Then
PutMem4 VarPtr(Merri), SysAllocStringByteLen(0, lngLen * Count)
MidB$(Merri, 1, lngLen) = Text
MidB$(Merri, lngLen + 1) = Merri
ElseIf Count = 1 Then
Merri = Text
End If
End If
End Function
Logophobic: 0,32319
dilettante: 4,52065
leinad31: 0,40865
Merri: 0,20261
Updated the code to work correctly with one character and half character strings:Code:Option Explicit
Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal Ptr As Long, ByVal Length As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)
Public Function Merri(ByVal Count As Long, ByRef Text As String) As String
Dim lngLen As Long
lngLen = LenB(Text)
If lngLen Then
If Count > 1 Then
PutMem4 VarPtr(Merri), SysAllocStringByteLen(0, lngLen * Count)
MidB$(Merri, 1, lngLen) = Text
If lngLen > 2 Then
MidB$(Merri, lngLen + 1) = Merri
ElseIf lngLen = 2 Then
MidB$(Merri, 3, 2) = Text
If Count > 2 Then MidB$(Merri, 5) = Merri
ElseIf lngLen = 1 Then
MidB$(Merri, 2, 1) = Text
If Count > 2 Then MidB$(Merri, 3, 1) = Text
If Count > 3 Then MidB$(Merri, 4, 1) = Text
If Count > 4 Then MidB$(Merri, 5) = Merri
End If
ElseIf Count = 1 Then
Merri = Text
End If
End If
End Function
No, I did not forget it. I couldn't find the thread, and now I'm snarled up in a huge application. :blush:Quote:
Originally Posted by anhn
Logophobic built some super-fast code on that thread also. However, in my own fruitless defense, OP appeared to be looking for a small, simple solution rather than a brute. :eek:
Thanks for the Link.
For what it's worth, here's some simplistic code that will likely be much faster than using the Replace() function for building a big string that repeats a little one. Again, I will build 92 Johns:
That might save a few nanoseconds because the string grows nonlinearly--2, 4, 8, 16, 32, etc. Worst-case scenario is that the next to the last loop builds a string that is only a few bytes less than the required length, so Left$() has to truncate it almost in half at the finish.Code:Const Repeats = 92 ' Adjust as you see fit
Private Sub Command1_Click()
Dim MyString As String, StrLen As Long
MyString = "John"
StrLen = Len(MyString) * Repeats
Do While Len(MyString) < StrLen
MyString = MyString & MyString
Loop
MyString = Left$(MyString, StrLen)
MsgBox MyString
End Sub
Inlined longer code is already hard to follow. To make comparing code lengths easier, here is a function version of your code:Here is a compacted version of my code for comparison:Code:Public Function Code_Doc(ByVal Count As Long, ByRef Text As String) As String
Dim StrLen As Long
Code_Doc = Text
StrLen = Len(Code_Doc) * Count
Do While Len(Code_Doc) < StrLen
Code_Doc = Code_Doc & Code_Doc
Loop
Code_Doc = Left$(Code_Doc, StrLen)
End Function
Code:Public Function Merri(ByVal Count As Long, ByRef Text As String) As String
Merri = String$(Len(Text) * Count, Text)
Mid$(Merri, 1, Len(Text)) = Text
Mid$(Merri, Len(Text) + 1) = Merri
End Function
Merri, your modified code is easy to understand by anyone (including me) and it executes faster that anything I have ever seen written on this issue. (Swapping is ramarkably fast and enjoys a lack of concatenation, which is notoriously slow--perhaps even when concatenation grows strings in a non-linear rate, as I posted). :thumb:Quote:
Originally Posted by Merri
I believe that Logophobic might also agree, but he needs to test your above posted function against his code that he posted last year that was also easy to understand but yet lightning quick.;)
Merri, your modified code is easy to understand by anyone (including me) and it executes faster that anything I have ever seen written on this issue. (Swapping is ramarkably fast and enjoys a lack of concatenation, which is notoriously slow--perhaps even when concatenation grows strings in a non-linear rate, as I posted). :thumb:Quote:
Originally Posted by Merri
I believe that Logophobic might also agree, but he needs to test your above posted function against his code that he posted last year that was also easy to understand but yet lightning quick.;)
I am really impressed with what you have written here, and I can easily adapt it to my all of applications. :cool:
Here is my version of Merri's code, attached to a command button to generate 92 Johns:
What is not obvious to anyone, except perhaps Merri, is how this code works with no looping whatsoever. Mid$() is powerful. Once again: :thumb:Code:Private Sub Command1_Click()
Dim Merri As String, Text As String, Count As Integer
Text = "John": Count = 92
Merri = String$(Len(Text) * Count, Text)
Mid$(Merri, 1, Len(Text)) = Text
Mid$(Merri, Len(Text) + 1) = Merri
MsgBox Merri
End Sub
It probably wasn't obvious to Merri either. I played with it for a minute, and found that Mid() is not able to repeat a single character string. I scratched my head for another minute before I realized exactly what was going on: Mid() copies 4 bytes (2 characters) at a time. Merri's compact function does repeat a single character because it uses String$() to initialize the return string.
Here's what the Mid() statement is doing:
I've noticed that Mid() is less efficient when length of the string being repeated is odd. This can be alleviated by copying the text twice before using the Mid() statement for additional replication.Code:s="123------"
Mid(s, 4) = s
Read 4 bytes from s: "123------"
Write 4 bytes to s: "12312----"
Read 4 bytes from s: "12312----"
Write 4 bytes to s: "1231231--"
Read 4 bytes from s: "1231231--"
Write 4 bytes to s: "123123123"
Code:Public Function Merri(ByVal Count As Long, ByRef Text As String) As String
Merri = String$(Len(Text) * Count, Text)
If Len(Text) > 1 Then
Mid$(Merri, 1, Len(Text)) = Text
If Count > 1 Then Mid$(Merri, Len(Text) + 1) = Merri
End If
End Function
Public Function MerriLogo(ByVal Count As Long, ByRef Text As String) As String
MerriLogo = String$(Len(Text) * Count, Text)
If Len(Text) > 1 Then
Mid$(MerriLogo, 1, Len(Text)) = Text
If Count > 1 Then
Mid$(MerriLogo, Len(Text) + 1, Len(Text)) = Text
If Count > 2 Then Mid$(MerriLogo, Len(Text) + Len(Text) + 1) = MerriLogo
End If
End If
End Function
It appears to me that the OP who asked for a very simple answer to a very simple question may have a slight problem determining which one of the contest examples to pick from.
I think that at this point, Merri and Logophobic have driven us all loco, encouraged somewhat by AnHn. My hat's off to all three of them. :bigyello:Quote:
Originally Posted by jmsrickland
pssst... Merri may need to check Logophobic's odd/even string length claim.
This code generate's 92 Sues just as easily as it generates 92 Johns and also works with single-character and double-character strings. I'm not sure where or how it is going to fail:
Code:Private Sub Command1_Click()
Dim Merri As String, Text As String, Count As Integer
Text = "Sue": Count = 92
Merri = String$(Len(Text) * Count, Text)
Mid$(Merri, 1, Len(Text)) = Text
Mid$(Merri, Len(Text) + 1) = Merri
MsgBox Merri
End Sub
Another version:
Code:Function RepeatStr(sText As String, Count As Long) As String
If Len(sText) And (Count > 0) Then
RepeatStr = Space$(Len(sText) * Count)
LSet RepeatStr = sText
Mid$(RepeatStr, Len(sText) + 1) = RepeatStr
End If
End Function