Excel'de bir metinden rakamları çekmek





Harf rakam karışık halde bulunan 1 veya birden çok hücrede yanyana bulunan rakamları birleştirerek rakam grupçukları oluşturur, yani sadece metin içindeki rakamları ayıran makro kodu.

Sub rakamayir()
--- değişkenleri tanımla---
Dim dizi(750)
Dim dizison(750)
Dim durum As Boolean
Dim A, b, d, i, j, bos
Dim dd, ddd, f, ff, fff, k, kk, kkk, sayi
Dim c As Range
Columns(1).ClearContents
‘---seçili her hücredeki rakamları seç ve ayır---
For Each c In Range(Selection.Address)
For k = 1 To Len(c)
kk = Mid(c, k, 1)
If Asc(kk) > 47 And Asc(kk) < 58 Then
sayi = sayi & kk
durum = True
Else
If durum = True Then
durum = False
dizi(i) = Val(sayi)
i = i + 1
sayi = Empty
End If
End If
Next k
‘--- ayrılan sayı grupçuklarını dizi() adlı dizi değişkenine at---
If durum = True Then
durum = False
dizi(i) = Val(sayi)
i = i + 1
sayi = ""
End If
Next

--- dizi() değişkenine atanan rakamları sırala---
For d = 0 To i
For dd = 0 To i
If dizi(d) < dizi(dd) Then
bos = dizi(d)
dizi(d) = dizi(dd)
dizi(dd) = bos
End If
Next
Next

--- yeni bir dizi oluşturarak önceki dizide tekrar eden rakamlardan kurtuluyoruz, yeni dizide önceki dizideki rakamlar birer kez alınmış oluyor, tekrar önleniyor---
dizison(0) = dizi(0)
For k = 0 To i
If dizison(iii) <> dizi(k) Then
dizison(iii + 1) = dizi(k)
iii = iii + 1
End If
Next

--- işin en tatlı yeri, ulaşmak istediğimiz sonuca ulaştık artık çıktıyı istediğimiz yere yansıtabilir, bu sonuçları dilediğimiz şekilde kullanabiliriz. Biz sonucu Excel hücrelerine yazdırıyoruz---
For i = 0 To iii
Cells(i + 1, 1) = "DSİ. " & dizison(i)
Next

--- Çalışmaya devam edersen, çok ilerleyeceksin---
End Sub

saol dostum

emeğine sağlık dostum güzell
bişi soracam peki exelde mesela alt alta aynı sütünda üsmler yazdım bunlarıda sırayla alan bi code biliyormusun mesela bunları listboxa yazsın yapılabilirmi??