Satırdan Parça Al ???

halily · 02-07-2021, 17:39

Dosyanız eklenmemiş, winrar ile sıkıştırıp öyle eklemeyi denediniz mi ?

jon206 · 02-07-2021, 17:40

MRB.LAR
BUDA BENDEN ALTERNATİF KOD Wink

METİN3 KUTUSNDAN ALDIRDIM SİZ DEĞİŞTİREBİLİR SİNİZ..
ÇEŞİTLİLİK OLSUN...

Visual Basic
Dim v As Variant
 
v = Split(Me.Metin3, "Komisyon")
v = Split(v(1), ",Bloke")
v = Replace(Trim(v(0)), " ", "")
v = Mid(v, 2, Len(v))
MsgBox v

SBNS · 02-07-2021, 18:24

ACCES DOSYASI EKTEDİR ARKADAŞLAR

halily · 02-07-2021, 19:09

aşağıdaki dosyada hem RegExp hem de kendi oluşturduğum fonksiyon var, 2 yöntem için 2 sorgu oluşturdum istediğinizi kullanabilirsiniz.
not 1: fonksiyonlu sorgu daha hızlı RegExp yöntemi biraz kasıyor
Not 2: regExp fonksiyonu Virgül "," ile başlayan değerleri almıyor o nedenle Komisyon_Fonk adlı sorguyu kullanmanızı öneririm.
siz yine de iyice kontrol edin hatalarım olabilir
iyi çalışmalar

halily · 02-07-2021, 19:49

veri aralığı kesinlikle komisyon ile Bloke aralığında ise sayın @jon206 'nın kodunu da aşağıdaki gibi düzenleyebilirsiniz
aşağıdaki kodu yine Modüle ekleyip sorgudan çağıracaksınız

Visual Basic
Function KomisyonJon(Mtn As String) As Double
Dim v As Variant
 
v = Split(Mtn, "Komisyon")
v = Split(v(1), "Bloke")
v = Replace(Trim(v(0)), " ", "")
v = Mid(v, 2, Len(v))
v = IIf(IsNumeric(Right(v, 1)), v, Left(v, Len(v) - 1))
KomisyonJon = v
End Function

sorgu kodu

Visual Basic
SELECT TABLO.AÇIKLAMA, TABLO.TUTAR, KomisyonJon([AÇIKLAMA]) AS Komisyon, KomisyonJon([AÇIKLAMA])+[TUTAR] AS Toplam, TABLO.Kimlik
FROM TABLO;

halily · 02-07-2021, 23:58

aşağıda 3 farklı yöntemle elde edilmiş sonuçlar var, RegExp yöntemi için referanslardan Microsoft VBScript Regular Expressions x.x kütüphanesini kullanıp desen/pattern kodunu değiştirince RegExp de hem hızlı hem de doğru sonuç verdi
RegExp yöntemi referanslara Microsoft VBScript Regular Expressions x.x kütüphanesi eklenmeli

Visual Basic
Function RegExpSayi(Mtn As String) As Double
'    Dim RegEx As Object
'    Set RegEx = CreateObject("vbscript.regexp")
    Dim RegEx As RegExp
    Set RegEx = New RegExp
 
        RegEx.IgnoreCase = True
        RegEx.Global = True
        RegEx.Multiline = True
        RegEx.Pattern = "Komisyon\s{0,}:\s{0,}\d{0,}(\.|,|[0-9]){0,}\d+"
        
    Set Uyan = RegEx.Execute(Mtn)
        For Each match In Uyan
            RegExpSayiTmp = match.Value
        Next match
        
        RegExpSayiTmp = Trim(Replace(RegExpSayiTmp, "Komisyon", ""))
        RegExpSayiTmp = Trim(Replace(RegExpSayiTmp, ":", ""))
'        RegExpSayiTmp = Trim(Replace(RegExpSayiTmp, ":", ""))
If Len(RegExpSayiTmp & "") = 0 Then RegExpSayiTmp = 0
        RegExpSayi = RegExpSayiTmp
End Function

benim oluşturduğum fonksiyon

Visual Basic
Function KomisyonFonk(Mtn As String) As Double
    Mtn = Replace(Mtn, " ", "")
    If InStr(Mtn, "Komisyon:") < 1 Then
        KomisyonFonk = 0
        Exit Function
    End If
    bas = InStr(Mtn, "Komisyon:") + Len("Komisyon:")
    For x = bas To Len(Mtn & "")
        If IsNumeric(Mid(Mtn, x, 1)) Or Mid(Mtn, x, 1) = "," Or Mid(Mtn, x, 1) = "." Then Else Exit For
        Bit = x
    Next x
     
    TmpStr = Trim(Mid(Mtn, bas, Bit - bas + 1))
    For x = Len(TmpStr & "") To 1 Step -1
        If IsNumeric(Mid(TmpStr, x, 1)) Then Exit For
    Next x
     
    KomisyonFonk = Mid(TmpStr, 1, x)
 
End Function

Sayın @jon206 'nın yöntemiyle
bu yöntem verinin Komisyon ile Bloke ifadeleri arasında olduğunu varsayar

Visual Basic
Function KomisyonJon(Mtn As String) As Double
Dim v As Variant
 
    v = Split(Mtn, "Komisyon")
    v = Split(v(1), "Bloke")
    v = Replace(Trim(v(0)), " ", "")
    v = Mid(v, 2, Len(v))
    v = IIf(IsNumeric(Right(v, 1)), v, Left(v, Len(v) - 1))
    KomisyonJon = v
End Function

Benzer Konular...
Konu:		Yazar	Cevaplar:	Gösterim:	Son Mesaj
	[RAPOR] Tablodaki Ilk Satırdan Sonraki Satırı Rapora çağırma (dlookup Yardımı)	RENATO	6	381	08-12-2021, 21:02 Son Mesaj: alperalper
	YEDEK PARÇA TAKİP	akimsar	3	826	26-03-2019, 08:59 Son Mesaj: celalll
	[FORM] Takım Paket ve Parça Bazlı Stok Tutmak Hakkında Yardım	hersey	3	1.209	11-08-2018, 18:08 Son Mesaj: hersey
	[VBA] PARÇA ALMA	hedefkaya	1	2.221	01-08-2016, 01:59 Son Mesaj: dsezgin
	[VBA] Metinden Parça al	idrisy	4	4.011	23-04-2016, 00:20 Son Mesaj: idrisy
	Parça takibi başlangıç	LetsDie	8	3.505	18-09-2014, 20:20 Son Mesaj: LetsDie
	[FONKSiYON] Personel izinlerinde bir üst satırdan çıkararak ve toplayarak yazdırma	Nevzat Gürbüz	9	3.558	25-03-2014, 17:14 Son Mesaj: assenucler
	[VBA] araba servis yedek parca otomasyonu	zerobattal	1	3.104	03-05-2013, 02:51 Son Mesaj: dsezgin

Oturum Aç




Beni Hatırla Şifremi Unuttum?

Access SQL