Prikazi cijelu temu 21.02.2012 21:39
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Lokacija:Tuzla


Predmet:Re: Usporedba stringa
Evo ti ova procedura.
Mislim da ce ti bolje ova pasati od predhodne pa da ne popravljam nju.
PreuzmiIzvorni kôd (Visual Basic):
  1. Private Sub txtUpit_BeforeUpdate(Cancel As Integer)
  2. Dim Rs As Recordset
  3. Dim Db As Database
  4. Dim Podatak(1 To 2) As String, Slicni(1 To 5) As String, Znak As String, MsgSlicni As String
  5. Dim I As Integer, Duz As Integer, Poeni As Integer, Stanje As Single, X As Integer
  6. Dim Poz As Integer, StartP As Integer
  7.  
  8. If IsNull(Me.txtUpit) Then GoTo Kraj
  9. Podatak(1) = Me.txtUpit
  10. Duz = Len(Podatak(1))
  11. Set Db = CurrentDb
  12.  
  13. Set Rs = Db.OpenRecordset("SELECT Firma FROM TblPartneri")
  14.  
  15. Do While Not Rs.EOF
  16. Podatak(2) = Rs.Fields(0)
  17.     For I = 1 To Duz
  18.     If I = 1 Then
  19.     StartP = 1
  20.     Else
  21.     StartP = I - 1
  22.     End If
  23.     Znak = Mid(Podatak(1), I, 1)
  24.     Poz = InStr(StartP, Podatak(2), Znak)
  25.     If Poz = I + 1 Or Poz = I Or Poz = I - 1 Then
  26.     Poeni = Poeni + 1
  27.     End If
  28.     Next I
  29.     Stanje = Poeni / Duz
  30.     Poeni = 0
  31.     Poz = InStr(1, Podatak(2), Podatak(1))
  32.     If Poz > 0 Then Stanje = 1
  33.     If Stanje > 0.7 Then
  34.     X = X + 1
  35.     Slicni(X) = Podatak(2)
  36.     End If
  37. Rs.MoveNext
  38. Loop
  39. Rs.Close
  40. If X > 0 Then
  41. For I = 1 To X
  42. MsgSlicni = MsgSlicni & Slicni(I) & vbCr
  43. Next I
  44. MsgBox "Slicni su :" & vbCr & MsgSlicni
  45. End If
  46. Kraj:
  47. End Sub
Podrška samo putem foruma, jer samo tako i ostali imaju koristi od toga.