Boş satır , dolu satır

[excellcan]

Forumda emeği geçen herkese merhaba. Boş satır yada dolu satır bulma konusunda forumdaki örnekler ilgili sutunun tamamını baz alarak yapılıyor. Benim öğrenmek istediğim ise şu : Belli bir aralıktaki ilk boş hücreyi nasıl buluruz ? Varsayalım ki A1:A100 aralığında dağınık şekilde verilerimiz var. Örneğin A20:A30 aralığında ilk boş hücreyi nasıl bulabiliriz ?

 

[N.Ziya Hiçdurmaz]

yanıt

Sub bossec()
Dim sat As Integer
For sat = 20 To 30
    If Cells(sat, "a") = "" Then
    Cells(sat, "a").Activate
    Exit For
    End If
Next
End Sub

 

[excellcan]

Sub bossec()
Dim sat As Integer
For sat = 20 To 30
    If Cells(sat, "a") = "" Then
    Cells(sat, "a").Activate
    Exit For
    End If
Next
End Sub

Hocam ilginiz ve yanıtınız için çok teşekkür ederim. Bir hususu daha açıklığa kavuşturabilir miyiz ? Varsayalım ki aynı aralıkta 3 adet boş hücre var. Yazmış olduğunuz bu kod bu durumda son boş hücreyi bulur. Aynı aralıkta boş hücre sayısının 1 den fazla olması durumunda ilk boş hücreyi nasıl seçebiliriz ? İlginiz için tekrar teşekkürler .

Hocam özür dilerim. Kodu denememiştim. Verdiğiniz kodda boş hücre sayısının bir önemi yok. Her halükarda ilk boş hücreyi seçiyor. hoşgörünüze sığınarak tekrar özür diliyorum. sağlıcakla kalın.

 

[halit3]

Alternatif olarak A20:A30 aralığı için

aranan ilk değer

Sub aranan_ilk_deger() 'aranan ilk değer
Dim aranan As String
Dim Rng As Range
aranan = InputBox("Aranan kelimeyi yaz")
'If Trim(aranan) <> "" Then değer boş olmuyacaksa buranın tırnak işaretini kaldırın
With Sheets(ActiveSheet.Name).Range("[COLOR=red]A20:A30[/COLOR]")
Set Rng = .Find(What:=aranan, After:=.Cells(.Cells.Count), LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not Rng Is Nothing Then
Application.GoTo Rng, True
Else
MsgBox "Sonuç yok"
End If
End With
'End If değer boş olmuyacaksa buranın tırnak işaretini kaldırın
End Sub

Aranan son değer

Sub aranan_en_son_deger() 'aranan en son değer
Dim aranan As String
Dim Rng As Range
aranan = InputBox("Aranan kelimeyi yaz")
'If Trim(aranan) <> "" Then değer boş olmuyacaksa buranın tırnak işaretini kaldırın
With Sheets(ActiveSheet.Name).Range("[COLOR=red]A20:A30[/COLOR]")
Set Rng = .Find(What:=aranan, After:=.Cells(1), LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
If Not Rng Is Nothing Then
Application.GoTo Rng, True
Else
MsgBox "Sonuç yok"
End If
End With
'End If değer boş olmuyacaksa buranın tırnak işaretini kaldırın
End Sub

 

[excellcan]

Alternatif olarak A20:A30 aralığı için

aranan ilk değer

Sub aranan_ilk_deger() 'aranan ilk değer
Dim aranan As String
Dim Rng As Range
aranan = InputBox("Aranan kelimeyi yaz")
'If Trim(aranan) <> "" Then değer boş olmuyacaksa buranın tırnak işaretini kaldırın
With Sheets(ActiveSheet.Name).Range("[COLOR=red]A20:A30[/COLOR]")
Set Rng = .Find(What:=aranan, After:=.Cells(.Cells.Count), LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not Rng Is Nothing Then
Application.GoTo Rng, True
Else
MsgBox "Sonuç yok"
End If
End With
'End If değer boş olmuyacaksa buranın tırnak işaretini kaldırın
End Sub

Aranan son değer

Sub aranan_en_son_deger() 'aranan en son değer
Dim aranan As String
Dim Rng As Range
aranan = InputBox("Aranan kelimeyi yaz")
'If Trim(aranan) <> "" Then değer boş olmuyacaksa buranın tırnak işaretini kaldırın
With Sheets(ActiveSheet.Name).Range("[COLOR=red]A20:A30[/COLOR]")
Set Rng = .Find(What:=aranan, After:=.Cells(1), LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
If Not Rng Is Nothing Then
Application.GoTo Rng, True
Else
MsgBox "Sonuç yok"
End If
End With
'End If değer boş olmuyacaksa buranın tırnak işaretini kaldırın
End Sub

Halit hocam ilginiz ve emeğiniz için çok teşekkürler. Verdiğiniz kodları denerken biranda aklımda başka bir soru şekillendi. Varsayalım ki aynı aralıkta tekrarlı veriler var. Örneğin 4 tane Ankara olsun. Ben sizin çalışmanızdan esinlenerek şöyle bir soru oluşturdum. Tekrarlama sayısına göre arama yapabilir miyiz ? Şöyleki üçüncü Ankara'yı bul gibi. Yada ikinci Ankara'yı bul gibi. Umarım sorumu doğru anlatabilmişimdir.

 

[mancubus]

alternatif:

Sub ilkboş()

Dim rngSCB As Range, rngA As Range

Set rngSCB = Intersect(Range("A20:A30"), Cells.SpecialCells(xlCellTypeBlanks))
Set rngA = Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

If Not rngSCB Is Nothing Then
   rngSCB(1).Select
Else
   rngA.Select
End If

End Sub

 

[Skorpiyon]

Sub Bul()
b = InputBox("Bulmak İstediğniz Veri ?") 'Bulunacak Veri
c = InputBox("Kaçıncısını Bulmak İstiyorsunuz ?") 'istenilen
For a = 10 To 20 '10 ile 20. satırlar arası
If Cells(a, 1) = b Then d = d + 1 'bulduğunu say
If d = Val(c) Then 'bulduğun istenilene eşitse
Cells(a, 1).Select 'o satırı sec
GoTo 10 'döngüden çık
End If
Next
10
End Sub

 

[halit3]

Halit hocam ilginiz ve emeğiniz için çok teşekkürler. Verdiğiniz kodları denerken biranda aklımda başka bir soru şekillendi. Varsayalım ki aynı aralıkta tekrarlı veriler var. Örneğin 4 tane Ankara olsun. Ben sizin çalışmanızdan esinlenerek şöyle bir soru oluşturdum. Tekrarlama sayısına göre arama yapabilir miyiz ? Şöyleki üçüncü Ankara'yı bul gibi. Yada ikinci Ankara'yı bul gibi. Umarım sorumu doğru anlatabilmişimdir.

kod

Sub deneme()
sat = 0
Dim aranan As String
Dim kacinci As String
[COLOR=red]aranan[/COLOR] = InputBox("Aranan kelimeyi yaz.", "Aranan", "ara")
[COLOR=red]kacinci [/COLOR]= Application.InputBox("Kaçıncı sıradaki veriyi arıyorsunuz.", "Sayı girin", "1", 400, 30, , Type:=1)
    
If kacinci = False Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
With Range("[COLOR=red]a20:a30[/COLOR]")
Set c = .Find(aranan, .Cells(.Cells.Count), xlValues, xlWhole)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
sat = sat + 1
If sat = kacinci Then
Range(c.Address).Select
End
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With

If sat <> kacinci Then
MsgBox "aranan değer istenilen sırada bulunamadı" & Chr(10) & _
sat & " sirada var"
End
End If

End Sub

 

[excellcan]

Değerli hocalarım verdiğiniz yanıtlar için hepinize teşekkür ederim. Verdiğiniz kodları denedim. Sonuç istediğim gibi. Emeğinize , yüreğinize sağlık. sağlıcakla kalın.

 

[poll123]

Hocalarım selam ben dolu olan satırları seçtirmek ve sadece dolu olanları bir diziye aktarmak istiyorum..Bu dolu olan satırlarıda activecell.Row ile eşitlicem çünki aktif olan satırdakileri değil tüm dolu olan satırlardaki bilgiyi almak istiyorum lütfen yardımcı olurmusunuz