B1:B9 Aralığına A2:A21 arasındaki verilerin 5 ile 15 arasındaki sadece sayı olan kıs

[N.Ziya Hiçdurmaz]

Günün sorusu .B1:B9 Aralığına A2:A21 arasındaki verilerin 5 ile 15 arasındaki sadece sayı olan kısımları alınacak.

 

[Korhan Ayhan]

Selamlar,

Günün sorusu olarakmı sordunuz?

 

[Korhan Ayhan]

Selamlar,

Aşağıda makrolu çözüme ait kodları ve açıklamaları bulabilirsiniz. Kodda kullanılan "Val" terimi sayısal değerlerin ayrımında kullanılarak kodun daha hızlı çalışması sağlanmıştır.

Sub SAYI_AYIR()
    [B:B].Clear
    SATIR = 1
    For X = 2 To [A65536].End(3).Row
    If Val(Cells(X, 1)) >= 5 And Val(Cells(X, 1)) <= 15 Then
    Cells(SATIR, 2) = Val(Cells(X, 1))
    SATIR = SATIR + 1
    End If
    Next
    MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

'AÇIKLAMALAR
'1.SATIR - MAKROMUZA İSİM TANIMLIYORUZ.
'2.SATIR - B SÜTUNUNDAKİ DEĞERLERİ TEMİZLİYORUZ.
'3.SATIR - SATIR İSİMLİ DEĞİŞKENİMİZE 1 DEĞERİNİ VERİYORUZ.
'4.SATIR - X İSİMLİ FOR-NEXT DÖNGÜSÜ BAŞLATIYORUZ.
'5.SATIR - A SÜTUNUNDAKİ X DEĞERİNİN ALDIĞI İLK HÜCRENİN SAYISAL DEĞERİNİN 5 İLE 15 ARASINDA OLUP OLMADIĞINI SORGULUYORUZ.
'6.SATIR - EĞER ŞARTIMIZ GERÇEKLEŞİYORSA B SÜTUNUNA BU HÜCREDEKİ SAYISAL DEĞERİ AKTARIYORUZ.
'7.SATIR - SATIR İSİMLİ DEĞİŞKENİN DEĞERİNE 1 EKLİYORUZ.
'8.SATIR - ŞARTIMIZI SONLANDIRIYORUZ.
'9.SATIR - DÖNGÜMÜZE DEVAM EDİYORUZ.
'10.SATIR - KULLANICIYA İŞLEMİN BİTTİĞİNE DAİR BİLGİLENDİRME MESAJI VERİYORUZ.
'11.SATIR - MAKROMUZU SONLANDIRIYORUZ.

 

[zafer]

Merhaba

A sütununa karışık girilmiş sayı ve metinleri ayırır

Sub AYIR2()
'Karışık girilmiş sayı ve metinleri ayırır
Dim I As Integer
Dim Kar As String
'x değişkenine A sütunundaki verilerin adetini atıyoruz.
x = WorksheetFunction.CountA(Range("A:a"))
'a sütunundaki veri aralığı kadar döngü başlatıyoruz
For Each HUCRE In Range("A1:a" & x)
AYR = ""
'verinin bulunduğu hücrenin adresini al
ADRES = HUCRE.Address
'Metinin her karekterini tek tek sına
For I = 1 To Len(HUCRE)
'aktih hücredeki veriden I değerinden başlayarak 1 karakter al
Kar = Mid(HUCRE, I, 1)
'Her bir karekterin sayı olduğunu sına
If IsNumeric(Kar) = True Then
' Sayıları birleştir
AYR = AYR & Kar
End If
Next
'verinin olduğu hücrenin yanındaki hücreye bulunan sayıları yaz
Range(ADRES).Offset(0, 1) = AYR
Next
End Sub

Düzenleme: Soruda gözümden kaçan 5 ile 15 arasında kalan sayılar cevabımda yoktur.Cevabım tüm sayılar için geçerlidir.

 

[zafer]

Merhaba

verilerin 5 ile 15 arasındaki sadece sayı olan kısımları alınacak

Sub AYIR5()
'Karışık girilmiş sayı ve metinleri ayırır
Dim I As Integer
Dim ayr As Integer
Dim Kar As String
'x değişkenine A sütunundaki verilerin adetini atıyoruz.
x = WorksheetFunction.CountA(Range("A:a"))
'a sütunundaki veri aralığı kadar döngü başlatıyoruz
For Each HUCRE In Range("A1:a" & x)
ayr = 0
'verinin bulunduğu hücrenin adresini al
ADRES = HUCRE.Address
'Metinin her karekterini tek tek sına
For I = 1 To Len(HUCRE)
'aktih hücredeki veriden I değerinden başlayarak 1 karakter al
Kar = Mid(HUCRE, I, 1)
'Her bir karekterin sayı olduğunu sına
If IsNumeric(Kar) = True Then
' Sayıları birleştir
ayr = ayr & Kar
End If
Next
 If ayr >= 5 And ayr <= 15 Then
'verinin oldu&#287;u h&#252;crenin yan&#305;ndaki h&#252;creye bulunan say&#305;lar&#305; yaz
Range(ADRES).Offset(0, 1) = ayr
End If
Next
End Sub

 

[Levent Menteşoğlu]

Bende aşağıdaki kodu öneriyorum.

Sub aktar()
[a2:a65536].SpecialCells(xlCellTypeConstants, 2).Copy [b1]
[b:b].Replace What:="veri", Replacement:=""
End Sub
 
[COLOR=green]'İlk satır ctrl+g ile git penceresinden özel-metin seçiminin kod olarak karşılığıdır. Metin veriler seçilip B sütununa kopyalanır.[/COLOR]
[COLOR=green][/COLOR] 
[COLOR=green]'B sütununa aktarılan verilerden "veri" kısmı silinir.[/COLOR]

 

[N.Ziya Hiçdurmaz]

Yanıt

Bende böyle birşey düşünmüştüm.
Sub TEST()
[B1:B9].Clear
For bak1 = 1 To [A65000].End(3).Row
If Val(Range("A" & bak1)) >= 5 And Val(Range("A" & bak1)) <= 15 Then
S = S + 1
Range("B" & S) = Val(Range("A" & bak1))
End If
Next
End Sub
'1 b1:a9 aralığını temizliyoruz
'2 A sütün aralığında döngümüzü kuruyoruz
'3 5 ile 15 arasındaki sayıları kelimelerden ayırarak işlem için şart koşuyoruz
'4 S değişkenine +1 atıyoruz
'5 B sütununa koşula uyan değerleri alıyoruz

 

[sanalses]

neden dosyaları indiremiyorum bana lazım bu formul ama erişemiyorum