• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Metin içindeki Rakamı alma

Mustafa MUTLU

Destek Ekibi
Destek Ekibi
Katılım
24 Temmuz 2008
Mesajlar
1,587
Excel Vers. ve Dili
Ofis 2013 TR 32 Bit
Aşağıdaki örnekte A2 de ki metin içinden [ ] arasındaki rakamı B2 hücresine nasıl alabilirim ?..

muhtemelen [11] olabilir.


Teşekkürler...
 
Aşağıdaki gibi deneyiniz.:cool:
Kod:
ilk = InStr(1, [A2], "[")
son = VBA.InStrRev([A2], "]")
deg = Trim(Mid([A2], ilk + 1, son - 2))
MsgBox deg
 
Hocam msgbox ta 11] olabili veriyor.
Ben sadece 11 i almak istiyorum.
Rakam bazen tek de olabiliyor örneğin [2] gibi
Ayrıca b sütununa yazması lazım
a sütunundaki veri 500 satır var
a2 den a500 e kadar hepsini b2 den b500 e kadar yazması lazım.

Teşekkür ederim..
 
Bende doğru çalışıyor.
B2 de göstermek için.
Kod:
ilk = InStr(1, [A2], "[")
son = VBA.InStrRev([A2], "]")
Range("B2").Value = Trim(Mid([A2], ilk + 1, son - 2))
 
Bakın dosyayıda yolluyorum.:cool:
 

Ekli dosyalar

Bu şekilde deneyiniz.
Kod:
[b2:b500].Value = [a2:a500].Value
[b2:b500].Replace "[", ""
[b2:b500].Replace "]", ""
 
ikiside Olmadı hocam

ilk = InStr(1, [A2], "[")

Bu kodu A2 den A500 e kadar olanları B sütununa yazdırıp
C sütununa parça al soldan 2 diyerek sorunu çözebiliriz belki..

bunun için döngü lazım
[A2] bunun a3 a4 diye artması için.

Döngüyü nasıl uyarlarız..
 
evet onda hata varmış.
aşağıdaki kod doğru çalışıyor.
Kod:
ilk = InStr(1, [A2], "[")
son = VBA.InStrRev([A2], "]", VBA.Len(Range("A2").Value))
Range("B2").Value = Trim(Mid(Range("A2").Value, ilk + 1, son - ilk - 1))
 
Hocam

Range("B2").Value = Trim(Mid(Range("A2").Value, ilk + 1, son - ilk - 1))

Bu satır hata veriyor

Bunu düzeltirken A2 den A500 e kadar yapmasını da ayarlarsanız memnun olurum.
 
Hocam

Range("B2").Value = Trim(Mid(Range("A2").Value, ilk + 1, son - ilk - 1))

Bu satır hata veriyor

Bunu düzeltirken A2 den A500 e kadar yapmasını da ayarlarsanız memnun olurum.
Parantezi göremezse hata veriyor.
Parantezi olmayanları boş bırakıyor.
İşte döngü ve sonu.:cool:
Kod:
On Error Resume Next
Range("B2:B" & Rows.Count).ClearContents
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    ilk = InStr(1, Cells(i, "A").Value, "[")
    son = VBA.InStrRev(Cells(i, "A").Value, "]", VBA.Len(Cells(i, "A").Value))
    Cells(i, "B").Value = Trim(Mid(Cells(i, "A").Value, ilk + 1, son - ilk - 1))
Next
MsgBox "İşlem Tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly _
+ vbInformation, Application.UserName
 
Seyit Tiken Hocam Teşekkür ederim.
Orion1 Hocam Teşekkür ederim.
Orion1 Hocamın kodu işimi görüyor.
On Error Resume Next
Range("B2:B" & Rows.Count).ClearContents
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
ilk = InStr(1, Cells(i, "A").Value, "[")
son = VBA.InStrRev(Cells(i, "A").Value, "]", VBA.Len(Cells(i, "A").Value))
Cells(i, "B").Value = Trim(Mid(Cells(i, "A").Value, ilk + 1, son - ilk - 1))
Next
MsgBox "İşlem Tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly _
+ vbInformation, Application.UserName
 
Geri
Üst