Hej!

Jag skulle vilja hämta info från en text som jag har i en txtbox.

1. Antal tecken (utan space)

2. Antal av alla bokstäver (tex. A=2st B=3st osv)

3. Hur gör jag för att byta ut alla A till tex I ? (ska försöka göra ett lätt krypterings program) alla tecken ska bytas till någe annat så det kan ju krocka men hur fixar man så det inte gör det ??


Tack på förhand.
grunkan

1. antal = Len(Replace(text1.text," ",""))
2. Denna vet jag faktiskt inte, men jag tippar på Instr(text1.text,"A")något...
3. text1.text = Replace(text1.text,"A","I")


// Jompa

>1. Antal tecken (utan space)


Dim StrTextLangd As String

Private Sub Command1_Click()
StrTextLangd = Replace(Text1.Text, " ", "")
Label1.Caption = Len(StrTextLangd)
End Sub


2. Antal av alla bokstäver (tex. A=2st B=3st osv)


Private Sub Form_Load()
MsgBox InStr(1, Text1.Text, UCase("A")), vbOKOnly, "A"
MsgBox InStr(1, Text1.Text, LCase("A")), vbOKOnly, "a"
MsgBox InStr(1, Text1.Text, UCase("B")), vbOKOnly, "B"
MsgBox InStr(1, Text1.Text, LCase("B")), vbOKOnly, "b"
'osv...
End Sub



3. Hur gör jag för att byta ut alla A till tex I ? (ska försöka göra ett lätt krypterings program) alla tecken ska bytas till någe annat så det kan ju krocka men hur fixar man så det inte gör det ??

Replace(Strminvariabel, A, I)


'Nu ska man veta att jag är inte bäst, men jag försöker... :)
'Finns säkert bättre sätt!

Hej!

Tack för alla svar !! här kommer lite mer frågor

Molle om jag på fråga 2 vill lista både små och stora i samma hur gör jag då ?? och jag vill ladda in alla svar i vaiablar (antalA, antalB osv..) hur gör jag då ?

Går det att göra 1 utan att texten i text boxen blir ändrad ? typ ladda in den i en variabel?

Sen på 3:an om jag byter ut alla A till I och sedan vill byta alla I till T så kommer de som var A från början ochså bli T men det vill jag ju inte hur fixar jag det ??? det verkar vara det svåraste .....

Tack på förhand
grunkan

Hmmm... lite anmärkningar.

InStr ger inte antalet tecken utan positionen för det första tecknet.
Vill man ta reda på totala antalet får man nog snällt göra en loop och
kolla igenom hela strängen.

ex:

2. Antal av alla bokstäver (tex. A=2st B=3st osv)

private function antalTecken(tecken as string, sokStrang as string) as integer
dim antal as integer, pos as integer

pos = 1
do until pos = 0 and pos < len(sokstrang)
pos = instr(pos, sokstrang, tecken, vbtextcompare)
if pos <> 0 then
antal = antal +1
pos = pos +1
end if
loop

'pos blir 0 om bokstaven inte hittas i resten av strängen
'om bokstaven hittas ska man börja sökningen på efterföljande position
end function

Har inte testat ovanstående men det borde funka

/Emma

Fråga 1 - Räkna totalt antal bokstäver:
<code>
Option Explicit

Function LetterCount(Text As String) As Long
Dim Char As String
Dim Index As Long
For Index = 1 To Len(Text)
Char = Mid$(Text, Index, 1)
If LCase$() <> UCase$() Then
LetterCount = LetterCount + 1
End If
Next
End Function

Private Sub Command1_Click()
Debug.Print LetterCount(Text1.Text)
End Sub


</code>
Fråga 2 - räkna tecken:
<code>
Option Explicit

Function CharCount(Text As String) As Long()
Dim Data() As Byte
Dim Result() As Long
Dim Index As Long
ReDim Result(0 To 255)
Data = StrConv(Text, vbFromUnicode)
For Index = 0 To UBound(Data)
Result(Data(Index)) = Result(Data(Index)) + 1
Next
CharCount = Result
End Function

Private Sub Command1_Click()
Dim Index As Long
Dim Result() As Long
Result = CharCount(Text1.Text)
For Index = 0 To 255
If Result(Index) > 0 Then
Debug.Print Chr(Index) & "=" & Result(Index) & "st ";
End If
Next
Debug.Print
End Sub


</code>

Fråga 3 - Kryptera:
<code>
Option Explicit

Private Key() As Byte

Function Kryptera(Text As String, Key() As Byte) As String
Dim Data() As Byte
Dim Index As Long
Data = StrConv(Text, vbFromUnicode)
For Index = 0 To UBound(Data)
Data(Index) = Key(Data(Index))
Next
Kryptera = StrConv(Data, vbUnicode)
End Function

Private Sub Command1_Click()
Text1.Text = Kryptera(Text1.Text, Key)
End Sub

Private Sub Form_Load()
Dim Index As Long
ReDim Key(0 To 255) As Byte
For Index = 0 To 255
Key(Index) = Index
Next

'a(97)=i(105)
Key(97) = 105

'A(65)=I(73)
Key(65) = 73

'i(105)=a(97)
Key(105) = 97

'I(73)=A(65)
Key(73) = 65
End Sub
</code>

>Molle om jag på fråga 2 vill lista både små och stora i samma hur
>gör jag då ?? och jag vill ladda in alla svar i vaiablar
>(antalA, antalB osv..) hur gör jag då ?


Dim AntalA, AntalB As Integer

Private Sub Form_Load()
AntalA = InStr(1, Text1.Text, UCase("A"))
AntalA = AntalA + InStr(1, Text1.Text, LCase("A"))
MsgBox AntalA
AntalB = InStr(1, Text1.Text, UCase("B"))
AntalB = AntalB + InStr(1, Text1.Text, LCase("B"))
MsgBox AntalB
'osv...
End Sub



>Går det att göra 1 utan att texten i text boxen blir ändrad ? typ ladda in den i en variabel?

Det gör jag ju i mitt exempel.


>Sen på 3:an om jag byter ut alla A till I och sedan vill byta alla I till T så
>kommer de som var A från början ochså bli T men det vill jag ju inte hur
>fixar jag det ??? det verkar vara det svåraste .....

Det där är väl bara enkel matematik.
Om du först ska ändra A till I och sen I till T för du börja med alla I till T och SEN göra A till I:

I --> T
A --> I

Om du vill att små och stora boikstäver skall räknas tillsamans skriver du:
<code>
Result = CharCount(UCase(Text1.Text))
</code>
Eller:
<code>
Result = CharCount(LCase(Text1.Text))
</code>

Om du skriver "Dim AntalA, AntalB As Integer" blir AntalA en variant. Om du anger fjärde argumentet tiil vbTextCompare sökar den inte binärt.<br>
<br>
Du summerar ju bara första förekomsternas position. Om du ska räkna antalet förekomster med InStr. Skriver du på följande sätt:
<code>
Function CountString(Text As String, Find As String, Optional Compare As VbCompareMethod = vbBinaryCompare) As Long
Dim Index As Long
Dim FindLen As Long
FindLen = Len(Find)
Index = InStr(1, Text, Find, Compare)
Do While Index
CountString = CountString + 1
Index = InStr(Index + FindLen, Text, Find, Compare)
Loop
End Function
</code>

Skulle nog rekommendera en annan approach. Det tenderar att bli så att man behöver räkna förekomster av alla tecken. Då är det väl bättre att använda (man förutsätter att NumberOf är initierade med nollor):

<code>
Public Sub CountChars (ByVal Text As String, ByRef NumberOf(0 to 255) As Long)
Dim iPos As Long, iAscii As Long
For iPos = 1 to Len(Text) - 1
iAscii = Asc(Mid$(Text, iPos, 1))
NumberOf(iAscii) = NumberOf(iAscii) + 1
Next
End Sub
</code>

En annan metod för att räkna antalet av ett tecken kunde ju vara:
<code>
Public Function CountOf (ByVal Text As String, ByVal Find As String) As Long
CountOf = Len(Text)-Len(Replace(Text, Find, ""))
End Sub
</code>

/Niklas Jansson

Om du läser ovan så har jag redan skicka en liknande funktion. Optimerat den något genom att konvertera värdet till en bytarray. Samt att jag istället för att skicka in en parametar, retunerar resultatet i en array.<br>
<br>
Har ett förslag till din andra funktion:<br>
* För att hanter räkning av text som är längre än 1 tecken bör du divedera resultatet med längden på Find.<br>
* Lägg till argument för att ange Compare metod.<br>
Annars är den okej.
<code>
Public Function CountOf(ByVal Text As String, ByVal Find As String, Optional Compare As VbCompareMethod = vbBinaryCompare) As Long
CountOf = (Len(Text) - Len(Replace(Text, Find, "", , , Compare))) / Len(Find)
End Function
</code>

>Om du läser ovan så har jag redan skicka en liknande funktion
Sorry, jag ser nu när jag läser tråden igen att det var det du gjorde (och det slog mig också att jag faktiskt såg det innan).

>Samt att jag istället för att skicka in en parametar, retunerar resultatet i en array.
Att returnera en array bör väl inte vara effektivare? Något snyggare kod, kan tyckas, men VB måste ju allokera en helt ny array och initiera denna.

/Niklas Jansson

Jepp. Snyggare att retunera array. Tror inte det är effektivare. Funktionen blir mer lätt använd.<br>
<br>
Optimeringen är:
<code>
Dim Char as Byte
Dim Data() As Byte
Dim Index As Long
Data = StrConv(Text, vbFromUnicode)
For Index = 1 to UBound(Data)
Char = Data(Index)

Next


</code>
V.S.
<code>
Dim Char as Byte
Dim Index As Long
For Index = 1 to Len(Text)
Char= Asc(Mid(Text, Index, 1))

Next
</code>

ingen som skulle kunna göra mig en jätte tjänst ?

kan någon skapa programet som räknar antal av en bokstav(a-ö) ??
för mitt vb som jag har med mig på min bärbara funkar inte :( har skivorna hemma....

bara en txtbox som man klistrar in texten i sedan en knapp(räkna) så visas antal tecke i en txtbox eller label så här:
A = 3
B = 4
C = 7
osv..

det skulle göra mig jätte glad och det tar nog inte så långt tid för er proffs =)....

tack på förhand
en desperat grunkan

en fullt fungerande bokstavsräknare:

Private Sub Command1_Click()
Dim txt, bokstav, totalt
txt = Text1.Text
bokstav = 0
For n = 65 To 90
For i = 1 To Len(txt)
If UCase(Mid(txt, i, 1)) = Chr(n) Then
bokstav = bokstav + 1
End If
Next
totalt = totalt & Chr(n) & " = " & bokstav & vbCrLf
bokstav = 0
Next
n = Asc("Å")
For i = 1 To Len(txt)
If UCase(Mid(txt, i, 1)) = Chr(n) Then
bokstav = bokstav + 1
End If
Next
totalt = totalt & Chr(n) & " = " & bokstav & vbCrLf
bokstav = 0
n = Asc("Ä")
For i = 1 To Len(txt)
If UCase(Mid(txt, i, 1)) = Chr(n) Then
bokstav = bokstav + 1
End If
Next
totalt = totalt & Chr(n) & " = " & bokstav & vbCrLf
bokstav = 0
n = Asc("Ö")
For i = 1 To Len(txt)
If UCase(Mid(txt, i, 1)) = Chr(n) Then
bokstav = bokstav + 1
End If
Next
totalt = totalt & Chr(n) & " = " & bokstav & vbCrLf
bokstav = 0

MsgBox totalt
End Sub

du skulle inte kunna göra den fungerande(med txtbox och allt) och sedan compilera den pch lägga upp den ???skulle göra mig jätte glad.

mitt är ju trasigt som jag sa i ett tidigare inlägg (måste ha det nu och jag kommer inte åt min skiva förens nästa helg)

tack på förhand
grunkan

Har sammanställt ett exempel med min funktion:
Programarkivet:Räknar antal tecken

TACK SÅ JÄTTE MYCKET !!!!!!!!!!

hade lite otur precis när jag skulle ladda hem programmet(klickade på download länken) så gick pellesoft ner :( så jag fick koppla ner och vänta tills nu ... (sitter på modem just nu)

ett liten (bugg?) jag hittade var att den räknade nyarader 2 gånger... annars var det hur bra som helst precis som jag ville ha det... =)

tack
grunkan *glad*

En radbrytnin symboliseras med två tecken 13 - Carier Return Och 10 . Line Feed.<br>
<br>
Du kan ersätta 13 10 med bara 13 eller bara 10:
<code>
Result = CharCount(Reolace(UCase(Text1.Text), vbCrLf, vbCr))
</code>
Eller:
<code>
Result = CharCount(Reolace(UCase(Text1.Text), vbCrLf, vbLf))
</code>

Hej...
Jag löste det där för ett tag sedan hur man byter ut vissa bokstäver, eller ord i en textruta...
Sättet kanske inte är fullt så smidigt, men det fungerar jättebra när det är färdigt...
Jag gjorde nämligen så att jag hade en extra textbox (RichTxtBox) RTF -grej duvet (hoppas jag)... På den rutan var självklart Visible satt till False...
Då kopierade jag texten där bokstäverna skulle bytas ut till RTF-rutan.
Till den så finns det smidiga funktioner som heter Replace, och Find.
Man söker efter ett ord man letar efter, och ersätter det, och söker sedan efter nästa... När det är klart, flyttas den ändrade texten till den vanliga textrutan igen.. Ganska simpelt... Här har du lite av den koden jag använde mej av: (Kopiera den till en modul, och Call:a sedan till funktionen ChangeLetters när du vill byta bokstäverna)

<code>
Private EditNR As Integer
Public AntalNR As Integer
Private TxtFind As String
Private TxtReplace As String

Public Sub ChangeLetters()
AntalNR = 3 'Hur många olika typer av bokstäver det finns du vill byta ut

For EditNR = 1 To AntalNR
CheckInfo 'Kolla vilka som ska bytas ut med vad
goptions = rtfMatchCase
gCount = 0
frmF.EditSagan.SelStart = 0
frmF.EditSagan.SelLength = 0

'frmF = Fönstret där allt händer
'EditF = Textrutan som ska ändrar bokstäver (RTF)
'TxtOriginal = Textrutan som visar resultatet

Do
If frmF.EditF.Find(TxtFind, frmF.EditF.SelStart + frmF.EditF.SelLength, , goptions) = -1 Then
'Ingen bokstav hittad
''cmdFind.Caption = "&Find"
Exit Do
Else
gCount = gCount + 1 'Öka räknaren
frmF.EditF.SelText = TxtReplace 'Gör allt visuellt
End If

Loop
Next
frmF.TxtOrginal.text = frmF.EditF.text
End Sub


Private Sub CheckInfo()
Select Case EditNR 'Jag skriver in 3 exempel på bokstäver som ska bytas ut
Case 1
TxtFind = "I" 'text som ska ändras...
TxtReplace = "O" '...till det här
Case 2
TxtFind = "A"
TxtReplace = "B"
Case 3
TxtFind = "Q"
TxtReplace = "S"
End Select
End Sub
</code>

Jag tror d ska fungera så.. det är nu lätt att lägga till fler bokstäver bara genom att lägga till några "Case" och sedan öka EditNR till så många som finns.. annars blir d fel

/Jonte