Metin İçerisinden Sayı Alma

[sinim]

Selamlar,

Bir metin icerisinden ,metnin icinde bulunan bir sayıyı bir kod yardimi ile nasıl alabilirim ?

Örn : A1 Hücresinde "Murat04OK" ve ya "Harun98okdeğil" yazar.Ben B1 hücresine sadece 04 veya 98 yazmak istiyorum

Metin uzunlukları aynı olmayan yaklasık 3000 satır oldugunu belirmek isterim

Yardimlarinizi bekliyorum

Tesekkurler

 

[hamitcan]

Forumda arama yapın derim. Bir çok örnek mevcut idi. Bulamazsanız, kendi kütüphanemden birşeyler bulmaya çalışırım.

 

[sinim]

Sayın Hamitcan,

Formda aramadigim yer kalmadi ancak bulamadim

Yardimlarinizi bekliyorum

Tesekkurler

 

[ozgretmen]

Aşağıdaki kod ile A sütununda yer alan verileriniz içindeki sayıları B sütununda listeler.iyi çalışmalar...

Sub sayılari_al()
Dim nums As String
For i = 1 To Cells(65536, 1).End(xlUp).Row
    For b = 1 To Len(Cells(i, 1))
        If IsNumeric(Mid(Cells(i, 1), b, 1)) = True Then
            nums = nums & Mid(Cells(i, 1), b, 1)
        End If
   Next b
   Cells(i, 2) = nums
   nums = ""
Next i
End Sub

 

[Ali]

Bir modül içine aşağıdaki kodları ekleyiniz.

Function RakamAl(Hücre)
Dim Karakter, i As Integer
Dim Sonuç
For i = 1 To Len(Hücre)
Karakter = Mid(Hücre, i, 1)
If IsNumeric(Karakter) = True Then
Sonuç = Sonuç & Karakter
End If
Next i
RakamAl = Sonuç
End Function

Daha sonra =RakamAl(A1) şeklinde kullanabilirsiniz.

 

[sinim]

emeginize saglik

 

[onurtascan]

sn Ali elinize sağlık

 

[aliemre20]

Arkadaşlar sorduğunuz soru ve verdiğiniz çözümler tam da benim ihtiyacım olan çözümler.Günlük olarak İki satırdan oluşan metin içerisinde yaklaşık olarak 7 haneli 8 rakam kullanıyorum. ama bunları birbirinden ayırmak çok zamanımı alıyor. Çözümlerinizin benim hayatımı çok kolaylaştıracağı inancındayım fakat vermiş olduğunuz kodları nasıl kullanacağımı bilemiyorum. Yoğunluk nedeni ile de fazla vakit ayıramıyorum. Bana yardımcı olursanız çok sevineceğim. Lütfen bana yardım edin... Teşekkürler...

 

[Levent Menteşoğlu]

Arkadaşlar sorduğunuz soru ve verdiğiniz çözümler tam da benim ihtiyacım olan çözümler.Günlük olarak İki satırdan oluşan metin içerisinde yaklaşık olarak 7 haneli 8 rakam kullanıyorum. ama bunları birbirinden ayırmak çok zamanımı alıyor. Çözümlerinizin benim hayatımı çok kolaylaştıracağı inancındayım fakat vermiş olduğunuz kodları nasıl kullanacağımı bilemiyorum. Yoğunluk nedeni ile de fazla vakit ayıramıyorum. Bana yardımcı olursanız çok sevineceğim. Lütfen bana yardım edin... Teşekkürler...

Bir örnek dosya ekleyebilirsiniz.

 

[derinzirve]

TC Kimlik Numarası almak.

Ek'te olduğu gibi tabloda fiş açıklama bölümünde değişik yerlerde geçen TC kimlik numaralarını almak istiyorum, yardımcı olursanız sevinirim. Ama sadece 11 rakamdan oluşan TC kimlik numarası şimdiden teşekkür ederim.

 

[Murat OSMA]

Şu kodları bir deneyiniz;

Sub Rakam_Ayir()
Dim RegEx As Object, RegMatchCollection As Object, RegMatch As Object
Dim Myrange As Range, C As Range, OutPutStr As String
    Set RegEx = CreateObject("VBScript.RegeXP")
    With RegEx
        .Global = True
        .Pattern = ["\d+"]
    End With
    Set Myrange = Range("I2:I6")
    For Each C In Myrange
        OutPutStr = ""
        Set RegMatchCollection = RegEx.Execute(C.Value)
        For Each RegMatch In RegMatchCollection
            OutPutStr = OutPutStr & RegMatch
        Next
        C.Offset(0, 1).Value = OutPutStr
        C.Offset(0, 1).Value = Mid(C.Offset(0, 1), 1, 11)
        If Len(C.Offset(0, 1).Value) <> 11 Then
         C.Offset(0, 1).ClearContents
        End If
    Next
    Set RegMatchCollection = Nothing
    Set RegEx = Nothing
    Set Myrange = Nothing
End Sub

 

[Levent Menteşoğlu]

Ek'te olduğu gibi tabloda fiş açıklama bölümünde değişik yerlerde geçen TC kimlik numaralarını almak istiyorum, yardımcı olursanız sevinirim. Ama sadece 11 rakamdan oluşan TC kimlik numarası şimdiden teşekkür ederim.

Aşağıdaki kodu dosyanızda çalıştırın. Sadece 11 haneden oluşan sayıyı alarak "J" sütununa yazacaktır.

Sub tcnoyual()
Set nesne = CreateObject("VBScript.Regexp")
nesne.Global = True
nesne.Pattern = "\D(\d{11})\D"
For a = 2 To [I65536].End(3).Row
Set veri = nesne.Execute(Cells(a, "I"))
If veri.Count > 0 Then Cells(a, "j") = nesne.Execute(Cells(a, "I")).Item(0)
Next
Set nesne = Nothing
End Sub

 

[Murat OSMA]

Teşekkürler Levent Bey...

 

[derinzirve]

Levent Bey harika, tamda istediğim gibi çok teşekkür ederim.

 

[Levent Menteşoğlu]

Teşekkürler Levent Bey...

Levent Bey harika, tamda istediğim gibi çok teşekkür ederim.

Rica ederim. Kodda bazı satırları gereksiz yere döngünün içine almışım, onları düzelttim. Yukarıdaki kodu dikkate almanızı rica ederim.

 

[Korhan Ayhan]

Merhaba,

Bende Split+Ubound yöntemiyle hazırladığım alternatif kodu vermek istiyorum.

Benim bilgisayarımda 30.000 satır veride yaklaşık 5 saniye kadar sürede işlemi tamamlıyor.

Sub TC_NO_AYIR()
    Dim X As Long, Y As Integer, Veri As Variant, Zaman As Double
 
    Zaman = Timer
 
    Application.ScreenUpdating = False
 
    Range("J:J").ClearContents
 
    For X = 2 To Cells(Rows.Count, "I").End(3).Row
        Veri = Split(Cells(X, "I"), " ")
        For Y = 0 To UBound(Veri)
            If Len(Veri(Y)) = 11 And IsNumeric(Veri(Y)) Then
                Cells(X, "J") = Veri(Y)
                GoTo 10
            End If
        Next
10  Next
 
    Range("J:J").EntireColumn.AutoFit
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.000") & " Saniye", vbInformation
End Sub

 

[ertmer]

çözebilen varsa çok sevinirim hücre içerisinde sayı ve metni diğer hücreye bölmek

siteyi çok aradım fakat sonuç alamadım ekteki dosyayı inceler ve çözerseniz çok mutlu olurum kendim yapamadım

 

[toybuklu]

Merhaba Sayın hocalarım..

Benim de bu konuda bir problemim var umarım yardımcı olursunuz..
aşağıdaki konuyu ve örneği belirteyim kısaca şimdiden yardımlarınız için teşekkürler.

Örneğin.. bir hücrede free format bir metin var ve bu metin içerisinde birden fazla ancak başlangıç bitişlerinde * yıldız işareti var bu sayıları yandaki hücreye alt alta yazdırmak istiyorum .. Hücre içinde yazan kafadan uydurduğum içerik aşağıdaki gibidir hücre içerisinde aşağıdaki gibi yamaktadır. bu hücre içerindeki * yıldızlar arasındaki rakamları yan hücreye aynı hücre içinde alt alta yazdırmak istiyorum

merhaba;
Sizden haber bekliyorum işe cavap verilmemiş numaram. *53555555* adres kodum *553677737*8889937*44566788*88888444*933627788*88273366536* bu ralardan ulaşabilirsiniz. syg

Not: Buradaki * yıldızı koddan değiştirebilmeliyim.. farklı yöntemlerede açığım

 

[Murat OSMA]

Dosyanızı eklerseniz çaydan sonra yardımcı olmaya çalışırım.

 

[toybuklu]

Merhaba Murat Bey;

Dosya yükleyemiyorum ama linkini iletebiliyorum yardımlarınıza teşekkürler...

Linki kaldırıdım yanlış anlaşılmasın diye...

mevcutta her hücrede örnekteki gibi free format yazılar var.. ve her bir sayı ayrı ayrı ayırması ve yandaki tek hücreye alt alta yazması süper olur..