Jag vill redigera en sträng typ: *3*11***1**hej*1* så att den blir till: *3*11*1*hej*1*
Dvs att alla det inte finns 2 * efter varandra, de övriga * behövs ej.
Jag har prövat med instr, instrrev och mid$ utan framgång!!
Nu har jag gått över till att läsa in strängen i en array för att sen redigera den och det klarar jag av.
Går det med instr, instrrev eller mid$ funktioner??

Efter att ha tittat på tips-sidan och fått ideer och inspiration löste det sig på detta vis:
Public Function Redigera_Sträng(Packet As String)
Dim Pos As Long, Start As String, Sist As String
Do While 1
Pos = InStr(1, Packet, "**", vbTextCompare)
If Pos = 0 Then Exit Do
Start = Mid(Packet, 1, Pos - 1)
Sist = Mid(Packet, Pos + 1)
Packet = Start & Sist
Loop
Redigera_Sträng = Packet
txtRedPaket.Text = Packet
End Function
Tack till den som lagt dit tipset!!!

Har tagit mig friheten att optimera funktionen:

Public Function StripDoubleChar(ByVal Text As String, Char As String) As String
Dim Pos As Long
Dim Start As Integer
Dim sTemp As String
Dim sFind As String
Dim iCount As Integer
Start = 1
sTemp = Text
sFind = String(2, Char)

Do
Pos = InStr(Start, sTemp, sFind, vbBinaryCompare)
If Pos Then
Mid$(sTemp, Pos) = Mid$(sTemp, Pos + 1) & " "
iCount = iCount + 1
Start = Pos
Else
Exit Do
End If
Loop
StripDoubleChar = Left$(sTemp, Len(sTemp) - iCount)
End Function

Tack Andreas, jag ska testa din kod.

Andreas.......

Nu blir jag lite besviken på dig. Du har ju varit så säker tidigare på
optimering. Men nu börjar du tappa stinget. Jag har kollat din "optimerade"
variant av mike's kod. Följande har noterats.

1. Den varianten blir sämre ju fler konsekutiva tecken det finns i
strängen av den sort som skall filtreras bort. Det är ju då man vill
att algoritmen skall vara snabb eftersom den skall vara bra på att
just ta bort dubbla tecken av en viss sort.

2. Den är onödigt stor. En erfaren programmerare borde se att man
löser detta problem effektivast med en rekursiv funktion. (Du är väl
erfaren verkar det som i alla dina inlägg).



Därför kommer jag med mitt förslag till lösning.

Sample ====================================================

Public Function stripDoubleChar(ByVal s As String, ByRef ch As String) As String
stripDoubleChar = Replace(s, "**", "*", 1, -1, vbTextCompare)
If s = stripDoubleChar Then
Exit Function
Else
stripDoubleChar = stripDoubleChar(stripDoubleChar, ch)
End If
End Function

Sample ====================================================

Lyckligtvis var det ju inte din kod som du optimerade så du kanske kan
säga till ditt försvar att du skulle komma med en liknande lösning själv.

/peterh

Käre peterh, du är inte mer besviken på mig än vad jag själv är. Jag är inte en erfaren programmerare. Jag måste hävda mig själv genom att tracka ned på andra. Jag är inte bättre än någon annan. Jag är nog istället sämre. Måste därför till 150% av min tid försöker att lura alla. Tänk om någon skulle avslöja mig?

Och nej, jag tänkte inte använda en rekusiv funktion.

Och du... Tack för att du finns...

Nja, det var ju inte så att jag ville att du skulle bli sur eller så. Men
faktum är att många av dina exempel är bra och proffsiga, men det
är väl inte mer än rätt att även du ibland får en formsvacka. Man ser
ofta dig gå in och optimera och ändra andras förslag. Det har väl flera
sidor med sig att göra så. Fortsätt du, det är ju på detta viset vi lär oss,
genom att se hur andra gör. (Dessutom har du ju kryssat i proffs) på
ditt visitkort för VB6.)

Men du erkänn att jag lyckats fint med min stripDoubleChar det kanske
är detta som är skillnaden mellan utbildade och självlärda. De utbildade
har oftast kunskap i hur saker skall lösas, men kanske inte alltid kan
realisera detta för att erfarenheten med kodning är för liten.

De självlärda har inget problem med hackning av kod, men dom kanske
inte alltid kan det smartaste sättet att lösa ett problem på. Det bli en
egen hopkokad soppa som visserligen funkar men kanske inte alltid så
effektivt som den skulle kunna göra.

Lyckligtvis hör jag till den unika skaran som är dels självlärd, men
också utbildad. Vilket medför att jag är enastående säker på
programmering och algoritmer och datastrukturer och sådant.

Så visst är det bra att jag finns.

/peterh

Har gjort lite tester och funderat. Att göra funktionen rekursiv är helt onödigt. Det tar faktist längre tid att göra den rekursiv.

Public Function stripDoubleChar2(Text As String, Char As String) As String
stripDoubleChar2 = Replace(Text, Char & Char, Char, 1, -1, vbTextCompare)
If Text = stripDoubleChar2 Then
Else
stripDoubleChar2 = Replace(Text, Char & Char, Char, 1, -1, vbTextCompare)
End If
End Function

Det tar inte längre tid att utföra uppgiften med min rekursiva funktion än med de andra. Det går faktiskt fortare. Destor fler konsekutiva tecken som skall filtreras desto snabbare är min metod. Eran metod blir sämre och sämre ju fler konsekutiva tecken det är.

Tror du mig inte skall jag visa med exempel säg bara till.

De tester jag gjorde på min dator var med en strän som slumpades fram som var ca 32 kb stor och innehåller ca 40% "*". Min rekursiva variant var ca 100 gånger snabbare än era loopar.

/Peterh

Jämförde du med funktionen som du ser i mitt senaste inlägg?
Det är din funktion fast inte rekursiv. Den gör det operationer din rekursiva funktion gör. Eftersom den max utförs två gånger och det är det kommer ett ojämt antal * efter varandra...

Eller har jag fel???

Gjorde följande test:

Option Explicit

Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Sub Command1_Click()
Dim sTemp As String
Dim Start As Long
Dim sReturn As String
Dim Index As Integer
sTemp = GenText()

Start = GetTickCount()
For Index = 1 To 10
sReturn = stripDoubleChar(sTemp, "*")
Next
Debug.Print "stripDoubleChar: " & GetTickCount() - Start

Start = GetTickCount()
For Index = 1 To 10
sReturn = stripDoubleChar(sTemp, "*")
Next
Debug.Print "stripDoubleChar: " & GetTickCount() - Start

Start = GetTickCount()
For Index = 1 To 10
sReturn = stripDoubleChar(sTemp, "*")
Next
Debug.Print "stripDoubleChar: " & GetTickCount() - Start

Start = GetTickCount()
For Index = 1 To 10
sReturn = stripDoubleChar2(sTemp, "*")
Next
Debug.Print "stripDoubleChar2: " & GetTickCount() - Start

Start = GetTickCount()
For Index = 1 To 10
sReturn = stripDoubleChar2(sTemp, "*")
Next
Debug.Print "stripDoubleChar2: " & GetTickCount() - Start

Start = GetTickCount()
For Index = 1 To 10
sReturn = stripDoubleChar2(sTemp, "*")
Next
Debug.Print "stripDoubleChar2: " & GetTickCount() - Start

End Sub


Public Function stripDoubleChar(ByVal s As String, ByRef ch As String) As String
stripDoubleChar = Replace(s, "**", "*", 1, -1, vbTextCompare)
If s = stripDoubleChar Then
Exit Function
Else
stripDoubleChar = stripDoubleChar(stripDoubleChar, ch)
End If
End Function

Public Function stripDoubleChar2(Text As String, Char As String) As String
stripDoubleChar2 = Replace(Text, Char & Char, Char, 1, -1, vbTextCompare)
If Text = stripDoubleChar2 Then
Else
stripDoubleChar2 = Replace(Text, Char & Char, Char, 1, -1, vbTextCompare)
End If
End Function

Private Function GenText() As String
Dim Index As Integer
GenText = Space(32000)
For Index = 1 To 32000
If Int(Rnd * 5) < 2 Then
Mid$(GenText, Index, 1) = "*"
Else
Mid$(GenText, Index, 1) = "a"
End If
Next
End Function


Och får resultatet:
stripDoubleChar: 791
stripDoubleChar: 771
stripDoubleChar: 772
stripDoubleChar2: 570
stripDoubleChar2: 571
stripDoubleChar2: 581

Man förlorar på att göra funktionen rekursiv.
Håller du inte med mig? Har jag fel? Är jag dum?

(Jag är bäst) :O)

Ja Andreas nu har du fel......

Du är ute och cyklar nåt alldeles enormt.

1. Varför anropar du min rekursiva funktion 10 gånger i en loop ??
Det enda som måste göras är att anropa funktionen och när den är
klar så har du en sträng där det inte fins någon ** kvar.

2. Jag noterar att din funktion också anropas 10 gånger i en loop !!
Trots detta kan det hända att du har ** kvar i din sträng. För vad
händer då du har en startsträng med fler än 10 * efter varandra ??

I mitt nästa inlägg kommer jag visa en totalt korrekt jämförelse mellan
de båda funktionerna.

/peterh

Får be så hemskt mycket om ursäkt tänkte helt hel.... :O)

Vilken tur att du finns och inte tar illa upp av mina hemska påhopp... :O)

Denna kod är en modifierad variant av din kod. Dock genererar den en
hel del utskrifter som jag vill bespara detta forum. Men kom igen och fixxa
din funktion så den fungerar annars kan vi inte jämföra.

Sample Code ====================================

Option Explicit

Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Sub Command1_Click()

Dim sTemp As String
Dim start As Single
Dim tid As Single
Dim sReturn1 As String
Dim sReturn2 As String
Dim index As Integer
Dim antalTest As Integer
Dim p As Integer
Dim s As Integer
Dim dubbeltecken As Boolean

For antalTest = 1 To 4
sTemp = GenText(antalTest)
Debug.Print
Debug.Print
Debug.Print "====== STARTAR TEST " & antalTest & " ======"
Debug.Print
Debug.Print "> Rekursiv funktion testas på en sträng som är " & Len(sTemp) & " tecken lång"
start = GetTickCount()
sReturn1 = stripDoubleChar(sTemp, "*")
tid = GetTickCount() - start
Debug.Print "> Det tog " & tid & " ms att klara biffen."
Debug.Print "> Resultatsträngen är " & Len(sReturn1) & " tecken lång"
Debug.Print
Debug.Print "> Icke rekursiv funktion testas på en sträng som är " & Len(sTemp) & " tecken lång"
start = GetTickCount()
sReturn2 = stripDoubleChar2(sTemp, "*")
tid = GetTickCount() - start
Debug.Print "> Det tog " & tid & " ms att klara biffen."
Debug.Print "> Resultatsträngen är " & Len(sReturn2) & " tecken lång"
Debug.Print
Debug.Print "> Det är " & Str(sReturn1 = sReturn2) & " att retursträngarna är lika"
Debug.Print
If sReturn1 <> sReturn2 Then
Debug.Print "> Analyserar resultatet av rekursiv funktion........"
p = 0
p = InStr(1, sReturn1, "**", vbTextCompare)
If p = 0 Then
Debug.Print "> Den rekursiva funktionen löste uppgiften inga ** finns kvar"
Else
Debug.Print "> Den rekursiva funktionen löste inte uppgiften....."
p = 0
Debug.Print "> Fel hittades på följande positioner i strängen: ";
Do
p = InStr(p + 1, sReturn1, "**", vbTextCompare)
If p <> 0 Then Debug.Print p;
Loop Until p = 0
End If
Debug.Print
Debug.Print "> Analyserar resultatet av icke rekursiv funktion........"
p = 0
p = InStr(1, sReturn2, "**", vbTextCompare)
If p = 0 Then
Debug.Print "> Den icke rekursiva funktionen löste uppgiften....."
Else
Debug.Print "> Den icke rekursiva funktionen löste inte uppgiften....."
p = 0
Debug.Print "> Fel hittades på följande positioner i strängen: ";
Do
p = InStr(p + 1, sReturn2, "**", vbTextCompare)
If p <> 0 Then Debug.Print p;
Loop Until p = 0
End If
End If
Next antalTest


End Sub

Public Function stripDoubleChar(ByVal s As String, ByRef ch As String) As String
stripDoubleChar = Replace(s, "**", "*", 1, -1, vbTextCompare)
If s = stripDoubleChar Then
Exit Function
Else
stripDoubleChar = stripDoubleChar(stripDoubleChar, ch)
End If
End Function

Public Function stripDoubleChar2(Text As String, Char As String) As String
stripDoubleChar2 = Replace(Text, Char & Char, Char, 1, -1, vbTextCompare)
If Text = stripDoubleChar2 Then
Else
stripDoubleChar2 = Replace(Text, Char & Char, Char, 1, -1, vbTextCompare)
End If
End Function

Private Function GenText(i As Integer) As String
Dim index As Integer
GenText = Space(32000)
For index = 1 To 32000
If Int(Rnd * 5) < i Then
Mid$(GenText, index, 1) = "*"
Else
Mid$(GenText, index, 1) = "a"
End If
Next
End Function

Sample Code ====================================

/peterh

Tack för att du låter mig korrigera mitt fel.

här är en funktion som inte är rekursiv:


Public Function stripDoubleChar2(Text As String, Char As String) As String
Dim sTemp As String
Dim sFind As String
sFind = Char & Char
stripDoubleChar2 = Text
Do
sTemp = stripDoubleChar2
stripDoubleChar2 = Replace(stripDoubleChar2, sFind, Char, 1, -1, vbTextCompare)
Loop Until sTemp = stripDoubleChar2
End Function

Tjuv körde ditt test... Den är lite snabbar än den rekursiva funktionen. men inte mycket...