3 farklı yöntem kullanarak çözmeye çalıştım
RegExp, InStr ve Like karşılaştırma için hepsini aynı sayfada göstermeye çalıştım bu nedenle biraz ağır çalışabilir siz bir yöntemi seçeceğinizden sorun çıkarmaz
her yöntem için başına yöntemin adını yazdım gereksizleri silerseniz belirgin bir hızlanma olabilir
1 - sadece RegExp için gerekli Modüldeki fonksiyon:
Function Sayim(Aciklama As String) As String
Dim RegEx As Object, metin As String
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.Pattern = "[a-zA-Z]{0,3}[0-9]{6}" '"[a-zA-Z]{0,3}[0-9]+" '-->[0-9]{6} : 6 rakam ard arda,[0-9]+:en az bir rakam, [a-zA-Z]{0,3} 0 yada en fazla 3 harf
RegEx.Global = True 'Tüm değerleri bul
RegEx.MultiLine = True 'tüm satırlarda ara
Set eslesmeler = RegEx.Execute(Aciklama)
KelimeSayisi = eslesmeler.Count
For Each Kelime In eslesmeler ' bulunana tüm değerleri döngüye sokar
Kosulum = Kosulum & "','" & Kelime.Value
Next
If Kosulum <> "" Then Kosulum = Mid(Kosulum, 3) Else Kosulum = ""
Sayim = Kosulum
End Function
2 - hem RegExp hem de diğer yöntemler için gerekli modüldeki kod bu modül sadece sorgu değerlerini saklayan sabitler modülüdür :
Global Const SqlBos As String = "SELECT '' AS ID,'' AS TÜR, '' AS YIL, " & _
"'' AS [YÜRÜRLÜK TARİHİ], '' AS GRUBU, " & _
"'' AS YILDIZLI, '' AS KOD, '' AS ADI, " & _
"'' AS AÇIKLAMA, '' AS PUAN,'' AS FİYATI " & _
"FROM tbl_secilenhizmetler"
Global Const Sqltbl_kamu As String = "SELECT tbl_kamu.id AS ID, tbl_kamu.tür AS TÜR, yili AS YIL, " & _
"yururluk_tarihi AS [YÜRÜRLÜK TARİHİ], '' AS GRUBU, " & _
"'' AS YILDIZLI, kodu AS KOD, islem_adi AS ADI, " & _
"aciklama AS AÇIKLAMA, '' AS PUAN, Format([fiyat],'Currency') AS FİYATI " & _
"FROM tbl_kamu"
Global Const Sqltbl_sut_2b As String = "SELECT tbl_sut_2b.id AS ID, tbl_sut_2b.tür AS TÜR, yili AS YIL, " & _
"yururluk_tarihi AS [YÜRÜRLÜK TARİHİ], '' AS GRUBU, " & _
"'' AS YILDIZLI, kodu AS KOD, islem_adi AS ADI, " & _
"aciklama AS AÇIKLAMA, islem_puani AS PUAN, Format([islem_puani]*0.593,'Currency') AS FİYATI " & _
"FROM tbl_sut_2b"
Global Const Sqltbl_sut_2c As String = "SELECT tbl_sut_2c.id AS ID, tbl_sut_2c.tür AS TÜR, yili AS YIL, " & _
"yururluk_tarihi AS [YÜRÜRLÜK TARİHİ], islem_grubu AS GRUBU, " & _
"yildizli_islem AS YILDIZLI, kodu AS KOD, islem_adi AS ADI, " & _
"aciklama AS AÇIKLAMA, islem_puani AS PUAN, " & _
"Format([islem_puani]*0.593,'Currency') AS FİYATI " & _
"FROM tbl_sut_2c"
Global Const Sqltbl_turist As String = "SELECT tbl_turist.id AS ID, tbl_turist.tür AS TÜR, yili AS YIL, " & _
"yururluk_tarihi AS [YÜRÜRLÜK TARİHİ], '' AS GRUBU, " & _
"'' AS YILDIZLI, kodu AS KOD, islem_adi AS ADI, " & _
"aciklama AS AÇIKLAMA, '' AS PUAN, Format([fiyat],'Currency') AS FİYATI " & _
"FROM tbl_turist"
3 - liste kutusu güncellendiğinde kodu :
Private Sub liste_AfterUpdate()
kodu = liste.Column(6)
islemadı = liste.Column(7)
islem_turu = liste.Column(1)
islem_grubu = liste.Column(4)
yıldızlı_islem = liste.Column(5)
yururluk_tarihi = liste.Column(3)
If Len(liste.Column(8) & "") = 0 Then
acıklama = ""
' InStr Kullanarak veri alma____________________________
FaturaEdilemezInstr.RowSource = SqlBos
FaturaEdilemezInstr.Requery
' Like Kullanarak veri alma____________________________
FaturaEdilemezLike.RowSource = SqlBos
FaturaEdilemezLike.Requery
' RegExp Kullanarak veri alma___________________________
FaturaEdilemezRegExp.RowSource = SqlBos
FaturaEdilemezRegExp.Requery
Exit Sub
End If
Dim SqlInStr, SqlLike, SqlRegExp, TblAdi As String
Dim KosulumInStr, KosulumLike, KosulumRegExp As String
'metin kutusundaki değere göre çağrılacak sorgu kodu ve tablo Adı________________
SQLBx = Switch(islem_turu = "Kamu", Sqltbl_kamu, _
islem_turu = "Ek-2B", Sqltbl_sut_2b, _
islem_turu = "Ek-2C", Sqltbl_sut_2c, _
islem_turu = "Turist", Sqltbl_turist)
TblAdi = Switch(islem_turu = "Kamu", "tbl_kamu", _
islem_turu = "Ek-2B", "tbl_sut_2b", _
islem_turu = "Ek-2C", "tbl_sut_2c", _
islem_turu = "Turist", "tbl_turist")
'hy Açıklama Alanını RecordSettn Alma_______
Dim AciklamaRs As DAO.Recordset
Dim AciklamaSql As String
AciklamaSql = "SELECT " & TblAdi & ".id, " & TblAdi & ".aciklama " & _
"FROM " & TblAdi & _
" where " & TblAdi & ".id=" & liste.Column(0)
Set AciklamaRs = CurrentDb.OpenRecordset(AciklamaSql, dbOpenDynaset)
acıklama = Nz(AciklamaRs(1))
' InStr Kullanarak veri alma____________________________
KosulumInStr = " WHERE (InStr(1,'" & acıklama & "',[kodu])>0)" 'Çalıştı
SqlInStr = SQLBx & KosulumInStr & " ORDER BY yili DESC;"
FaturaEdilemezInstr.RowSource = SqlInStr
FaturaEdilemezInstr.Requery
' Like Kullanarak veri alma____________________________
KosulumLike = " WHERE (('" & acıklama & "') like '*' & [kodu] & '*')" 'Çalıştı
SqlLike = SQLBx & KosulumLike & " ORDER BY yili DESC;"
FaturaEdilemezLike.RowSource = SqlLike
FaturaEdilemezLike.Requery
' RegExp Kullanarak veri alma____________________________
KosulumRegExp = " WHERE ([KODU] IN (" & Sayim(acıklama) & "'" & ")) "
SqlRegExp = SQLBx & KosulumRegExp & " ORDER BY yili DESC;"
If Len(Sayim(acıklama) & "") = 0 Then SqlRegExp = SqlBos
FaturaEdilemezRegExp.RowSource = SqlRegExp
FaturaEdilemezRegExp.Requery
End Sub
