Gotta be a better way

[Tommy]

Hi Ya'll

I think there is a better way to do this, I just can't seem to get a grip on though:banghead:

Ok here I go:
I am searching a string 16+- times and replacing it with something else if a match is found. It looks to me like I could use RegExp but I can't get the replace right.


Private Sub Command1_Click()
Dim MyString As String
Set Ace = New RegExp
MyString = Chr(193) & " Here on each end " & Chr(195)
Ace.Pattern = "[\xC0-\xCF]" 'got a pattern that works now what?
Ace.Global = True
MsgBox Ace.Replace(MyString, "[1 [2 [3 [4 [5 [6 [7 [8 [9 [0 [Q [W [E [R [T")
Rplacing MyString
End Sub

'this one does what I want it to, but seems long and not too fast


Sub Rplacing(MyString As String)
MyString = Replace(MyString, Chr(193), "[2")
MyString = Replace(MyString, Chr(194), "[3")
MyString = Replace(MyString, Chr(195), "[4")
MyString = Replace(MyString, Chr(196), "[5")
MyString = Replace(MyString, Chr(197), "[6")
MyString = Replace(MyString, Chr(198), "[7")
MyString = Replace(MyString, Chr(199), "[8")
MyString = Replace(MyString, Chr(200), "[9")
MyString = Replace(MyString, Chr(201), "[0")
MyString = Replace(MyString, Chr(202), "[Q")
MyString = Replace(MyString, Chr(203), "[W")
MyString = Replace(MyString, Chr(204), "[E")
MyString = Replace(MyString, Chr(205), "[R")
MyString = Replace(MyString, Chr(206), "[T")
End Sub



I am processing approx. 500 pieces of text. I have been beating my head against a wall for 2 days now. :rofl:

[OBP]

I am sorry, I can't see what you are replacing with what. Can you give a simpler description?
As this is Excel why aren't you using Excel's replace?

[Jacob Hilderbrand]

We can make a loop for the first 9.



For i = 1 To 9
MyString = Replace(MyString, Chr(i + 192), "[" & i + 1)
Next i

[TheAntiGates]

I haven't used RegExp so I'll not speak on that. For your second routine here is another angle you could play. I'm not claiming it's any better, but it's more compact, and might perform better.


Dim i as long, sSpecChars, sReplChars
sSpecChars = Array( Chr(193), Chr(194), Chr(195), Chr(196), Chr(197), _
Chr(198), Chr(199), Chr(200), Chr(201), Chr(202), _
Chr(203), Chr(204), Chr(205), Chr(206) )
sReplChars = Array( "[2", ....
for i = ubound(sSpecChars) to 0
MyString = Replace(MyString, sSpecChars(i), sReplChars(i))
next i

Though I don't know if the non-optimizing nature of VBA would benefit from the code re-use, at least it would be easier to manage. You might try it. Also for maintainability/modification ease the two big arrays are Variants. You can see if tightening them up benefits performance (probably so, but significantly?).

Another performance idea would be to do If instr(MyString,sSpecChars(i)) > 0 before the replace. Since Assembler-clueless MS developers wrote both Instr and Replace, you'll just have to experiment as to whether the redundant check ultimately boosts performance. (Yet it will probably win big for you outright if the total incidence of replacements is low.)

I don't recognize the regular expression aspect of your data but you may have had the best idea going that way, and ignoring all this - I don't know.

Jake, there's an asymmetry in his replacement strings that fizzles out your very tight code. (Oh, nm, you said just for the first 9).

Though you didn't mention it, what you appear to be doing is a keyboard code translation/offset (your next unshown line was MyString = Replace(MyString, Chr(207), "[Y") , right?). Does that ring a bell for anyone in terms of an API call (I'm not aware of any)?

[Tommy]

Interesting input :)

I am changing fonts :) going from a .TTF to a .SHX(bigfont) I made a .TTF font that looks like the picture and a .shx font that looks the same. The problem is 2 different ways to display. Anyway I think the RegExp is the way to go but TheAntiGates is the best so far :)



Option Explicit
Public Ace As RegExp

Private Sub Command1_Click()
Dim MyString As String
Dim i As Integer
Dim StartT As Double
Dim StopT As Double
Dim aa As String
Set Ace = New RegExp
MyString = Chr(193) & " Here on each end " & Chr(195)
Ace.Pattern = "[\xC0-\xCD]" 'got a pattern that works now what?
Ace.Global = True
StartT = Timer
For i = 1 To 30000 'this one processes at 1.483 sec
MyString = Chr(193) & " Here on each end " & Chr(195)
Rplacing MyString
Next
StopT = Timer
MsgBox StopT - StartT
StartT = Timer
For i = 1 To 30000 'this one processes at 1.2189 sec
MyString = Chr(193) & " Here on each end " & Chr(195)
NRplacing MyString
Next
StopT = Timer
MsgBox StopT - StartT
StartT = Timer
For i = 1 To 30000 'processes in 0.11 sec
MyString = Chr(193) & " Here on each end " & Chr(195)
aa = Ace.Replace(MyString, "[2[3")
Next
StopT = Timer
MsgBox StopT - StartT
StartT = Timer
For i = 1 To 30000 'processes in 2.04 sec
MyString = Chr(193) & " Here on each end " & Chr(195)
RNRplacing MyString
Next
StopT = Timer
MsgBox StopT - StartT
StartT = Timer
For i = 1 To 30000 'processes in 1.03 sec
MyString = Chr(193) & " Here on each end " & Chr(195)
NoGates MyString
Next
StopT = Timer
MsgBox StopT - StartT
If Ace.Test(MyString) Then 'this looks like it would work better
Rplacing MyString
End If
Set Ace = Nothing
End Sub


'this one does what I want it to, but seems long and not too fast


Sub Rplacing(MyString As String)
MyString = Replace(Replace(Replace(Replace(Replace(Replace _
(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
Replace(Replace(MyString, Chr(192), "[1"), Chr(193), "[2"), _
Chr(194), "[3"), Chr(195), "[4"), Chr(196), "[5"), Chr(197), _
"[6"), Chr(198), "[7"), Chr(199), "[8"), Chr(200), "[9"), _
Chr(201), "[0"), Chr(202), "[Q"), Chr(203), "[W"), Chr(204), _
"[E"), Chr(205), "[R"), Chr(206), "[T")
End Sub

Sub NRplacing(MyString As String)
MyString = Replace(MyString, Chr(192), "[1")
MyString = Replace(MyString, Chr(193), "[2")
MyString = Replace(MyString, Chr(194), "[3")
MyString = Replace(MyString, Chr(195), "[4")
MyString = Replace(MyString, Chr(196), "[5")
MyString = Replace(MyString, Chr(197), "[6")
MyString = Replace(MyString, Chr(198), "[7")
MyString = Replace(MyString, Chr(199), "[8")
MyString = Replace(MyString, Chr(200), "[9")
MyString = Replace(MyString, Chr(201), "[0")
MyString = Replace(MyString, Chr(202), "[Q")
MyString = Replace(MyString, Chr(203), "[W")
MyString = Replace(MyString, Chr(204), "[E")
MyString = Replace(MyString, Chr(205), "[R")
MyString = Replace(MyString, Chr(206), "[T")
End Sub

Sub RNRplacing(MyString As String)
Ace.Pattern = "\xC0"
MyString = Ace.Replace(MyString, "[1")
Ace.Pattern = "\xC1"
MyString = Ace.Replace(MyString, "[2")
Ace.Pattern = "\xC2"
MyString = Ace.Replace(MyString, "[3")
Ace.Pattern = "\xC3"
MyString = Ace.Replace(MyString, "[4")
Ace.Pattern = "\xC4"
MyString = Ace.Replace(MyString, "[5")
Ace.Pattern = "\xC5"
MyString = Ace.Replace(MyString, "[6")
Ace.Pattern = "\xC6"
MyString = Ace.Replace(MyString, "[7")
Ace.Pattern = "\xC7"
MyString = Ace.Replace(MyString, "[8")
Ace.Pattern = "\xC8"
MyString = Ace.Replace(MyString, "[9")
Ace.Pattern = "\xC9"
MyString = Ace.Replace(MyString, "[0")
Ace.Pattern = "\xCA"
MyString = Ace.Replace(MyString, "[Q")
Ace.Pattern = "\xCB"
MyString = Ace.Replace(MyString, "[W")
Ace.Pattern = "\xCC"
MyString = Ace.Replace(MyString, "[E")
Ace.Pattern = "\xCD"
MyString = Ace.Replace(MyString, "[R")
Ace.Pattern = "\xCE"
MyString = Ace.Replace(MyString, "[T")
End Sub

Sub NoGates(MyString As String)
Dim i As Long, sSpecChars, sReplChars
sSpecChars = Array(Chr(192), Chr(193), Chr(194), Chr(195), Chr(196), Chr(197), _
Chr(198), Chr(199), Chr(200), Chr(201), Chr(202), _
Chr(203), Chr(204), Chr(205), Chr(206))
sReplChars = Array("[1", "[2", "[3", "[4", "[5", "[6", "[7", "[8", "[9", "[0", "[Q", "[W", "[E", "[R", "[T")
For i = UBound(sSpecChars) To 0
MyString = Replace(MyString, sSpecChars(i), sReplChars(i))
Next i
End Sub

[brettdj]

Tommy,

I think that with Vbscript RegExp that you are stuck with multi replace approach either by looping through the Execute method or using the Replace method

In Javascript I have read that "the replaceText argument can also be a function that returns the replacement text"

In vbscript you can modify the submatch string but not numerically, ie



Sub a()
Dim Reg As RegExp
Set Reg = New RegExp
Dim myst As String
myst = "1 ab 2a"
Reg.Pattern = "(\d)"
Reg.Global = True
' return *match*
MsgBox Reg.Replace(myst, "*$1*")
End Sub


Cheers

Dave

execute example, still a loop but shorter



Private Sub Command1_Click()
Dim Ace As RegExp, ExAce As MatchCollection, ExAceMatch As Match
Dim MyString As String
Set Ace = New RegExp
MyString = Chr(193) & " Here on each end " & Chr(195)
Ace.Pattern = "[\xC0-\xCF]" 'got a pattern that works now what?
Ace.Global = True
Set ExAce = Ace.Execute(MyString)
For Each ExAceMatch In ExAce
MyString = Replace(MyString, ExAceMatch, "[" & Asc(ExAceMatch) - 191)
Next
MsgBox MyString
End Sub

[Tommy]

Thanks Dave,

This is the pattern I ended up with I check to see if I need to go through the hassle first :), increased speed about 30%.

I may still go to the matches and submatches with a select case statement for the replace on each of the matches. I think it would be a lot of code but the speed increase may make it worthwhile later.

Interesting side note on the function TheAntiGates posted, I changed it to a dynamic string array using the split function, a set of array litteral strings both results were at least 3 times slower than the variants. Go figure.


Ace.Pattern = "[\xC0-\xCF" & Chr(0) & "\?]"
If Ace.Test(mAll.TEXT) Then
mAll.TEXT = NoGates(mAll.TEXT)
End If