• DİKKAT

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

Üstünde ve altında boş satırlar olan tabloda dolu satırları seçtirmek

G

Gungor_Alkan

Katılım
1 Şubat 2021
Mesajlar
21
Excel Vers. ve Dili
2007 Türkçe
Merhaba Üstadlarım,

Farklı aralıklarla arada boş satırları olan bir tablom var.
Tablomu basite indirgersem

A-B-C Kolonlarından oluşsun

1) Satır: İLÇESİ-ADI-SOYADI (Başlık satırı)
2) Satır: (Boş bırakıyorum)

3) Satır: ALİAĞA-AHMET-ALİAĞALI
4) Satır: ALİAĞA-MEHMET-ALİAĞALI
5) Satır: ALİAĞA-HASAN-ALİAĞALI

6) Satır: (Boş bırakıyorum)

7) Satır: ÇEŞME-AHMET-ÇEŞMELİ
8) Satır: ÇEŞME-MEHMET-ÇEŞMELİ
9) Satır: ÇEŞME-HASAN-ÇEŞMELİ
10) Satır: ÇEŞME-HÜSEYİN-ÇEŞMELİ
11) Satır: ÇEŞME-AYŞE-ÇEŞMELİ
12) Satır: ÇEŞME-FATMA-ÇEŞMELİ

13) Satır: (Boş bırakıyorum)

14) Satır: URLA-ALİ-URLALI
15) Satır: URLA-VELİ-URLALI
16) Satır: URLA-FURKAN-URLALI
17) Satır: URLA-HAKAN-URLALI

18) Satır: (Boş bırakıyorum)

19) Satır: BUCA-AHMET-BUCALI
20) Satır: BUCA-MEHMET-BUCALI
21) Satır: BUCA-HASAN-BUCALI
22) Satır: BUCA-HÜSEYİN-BUCALI
23) Satır: BUCA-AYŞE-BUCALI
24) Satır: BUCA-FATMA-BUCALI
25) Satır: BUCA-ALİ-BUCALI
26) Satır: BUCA-VELİ-BUCALI
27) Satır: BUCA-FURKAN-BUCALI
28) Satır: BUCA-HAKAN-BUCALI
29) Satır: BUCA-SERKAN-BUCALI

30) Satır: (Boş bırakıyorum)
...........................................

Yapmak istediğim activecell tabodaki kişilerin İLÇE adı ADI veya SOYADI herhangi birinde iken kodu çalıştırdığımda
Alt ve Üstte bulunan boş satırlara kadar dolu olan satırları seçsin

Kullandığım şöyle bir kod var

Sub satirsec()
ActiveCell.Select
Range(Rows(Selection.Row + 0), Rows(Selection.Row + 0)).Select
Range(Selection, Selection.End(xlDown)).Select
End Sub

bu kod bulunduğum yerden aşağıdaki boş satıra kadar olan dolu satırları seçiyor ancak ortada bir yerdeysem
üstteki boşluğa kadar olan dolu satırları da seçsin istiyorum

Yukarıdaki örnek tabloda

A24, B24 veya C24 Hücrelerinden birinde isem (BUCA-FATMA-BUCALI)

19,20,21, ..... ,29 satırlarını seçtirmek istiyorum.

Yardımcı olabilecek üstadlarıma şimdiden teşekkür ederim.
 
Merhaba
istediğiniz böyle bir şey mi ?
C++: 
Sub BulundugunBloguSec()

    If ActiveCell.Value = "" Then Exit Sub

    ActiveCell.CurrentRegion.Select

End Sub
 
Bu şekilde deneyin.
Kod: 
Sub DoluSatirlariSec()
Dim ws As Worksheet
Dim sonSatir As Long
Dim i As Long
Dim secilecekAlan As Range
Set ws = ActiveSheet
sonSatir = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
If ws.Cells(ws.Rows.Count, "B").End(xlUp).Row > sonSatir Then sonSatir = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
If ws.Cells(ws.Rows.Count, "C").End(xlUp).Row > sonSatir Then sonSatir = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
For i = 1 To sonSatir
If WorksheetFunction.CountA(ws.Range("A" & i & ":C" & i)) > 0 Then
If secilecekAlan Is Nothing Then
Set secilecekAlan = ws.Range("A" & i & ":C" & i)
Else
Set secilecekAlan = Union(secilecekAlan, ws.Range("A" & i & ":C" & i))
End If
End If
Next i
If Not secilecekAlan Is Nothing Then
secilecekAlan.Select
MsgBox "Dolu satırlar başarıyla seçildi!", vbInformation, "İşlem Tamam"
Else
MsgBox "A, B ve C sütunlarında hiç veri bulunamadı.", vbExclamation, "Veri Yok"
End If
End Sub
 
Seyit Hocam birkaç gündür bakamadım geç dönüş yapabildim kusura bakmayın.
Uzunca kodlar yazmışsınız belli ki epeyce emek harcamışsınız hakkınızı helal edin.

Belli ki ben tam anlatamamışım. Kodlar tam olarak benim istediğimi yapmadı.

Benim tablomda belli aralıklarla boş bir satır var.
Dolu satırların sayısı değişebiliyor. Dolu satır sayısı bir satırda olabilir, daha fazlasıda olabilir.
Dolu satır sayısının standardı yok. Herbir kırılımın altında ve dolayısı ile üstünde mutlaka boş birer satır var.
Benim yapmak istediğim activecell dolu satırlardan herhangi bir hücrede iken, activecell'in üstünde ve altında bulunan
boş satırlara kadar olan aradaki (A?:C?) hücrelerini seçsin.


Emekleriniz için şimdiden sağolun.
 
Bu şekilde bir deneyin, eksik bir şey varsa dönüş yaparsınız.
Kod: 
Sub BosSatirlariSec()
Dim ws As Worksheet
Dim seciliHucre As Range
Dim rowUp As Long, rowDown As Long
Dim col As Long
Dim secimAlani As Range
Set ws = ActiveSheet
Set seciliHucre = ActiveCell
If Not Intersect(seciliHucre, ws.Range("A:C")) Is Nothing And seciliHucre.Value <> "" Then
col = seciliHucre.Column
rowUp = seciliHucre.Row
Do While ws.Cells(rowUp, col).Value <> "" And rowUp > 1
rowUp = rowUp - 1
Loop
rowDown = seciliHucre.Row
Do While ws.Cells(rowDown, col).Value <> "" And rowDown < ws.Rows.Count
rowDown = rowDown + 1
Loop
If ws.Cells(rowUp, col).Value = "" And ws.Cells(rowDown, col).Value = "" Then
Set secimAlani = Union(ws.Rows(rowUp), ws.Rows(rowDown))
secimAlani.Select
ElseIf ws.Cells(rowUp, col).Value = "" Then
ws.Rows(rowUp).Select
ElseIf ws.Cells(rowDown, col).Value = "" Then
ws.Rows(rowDown).Select
Else
MsgBox "Üstte veya altta boş satır bulunamadı.", vbInformation, "Bilgi"
End If
Else
MsgBox "Lütfen A, B veya C sütunlarında yer alan DOLU bir hücre seçin", vbExclamation, "Geçersiz Seçim"
End If
End Sub
 
Seyit Hocam birkaç gündür bakamadım geç dönüş yapabildim kusura bakmayın.
Uzunca kodlar yazmışsınız belli ki epeyce emek harcamışsınız hakkınızı helal edin.

Belli ki ben tam anlatamamışım. Kodlar tam olarak benim istediğimi yapmadı.

Benim tablomda belli aralıklarla boş bir satır var.
Dolu satırların sayısı değişebiliyor. Dolu satır sayısı bir satırda olabilir, daha fazlasıda olabilir.
Dolu satır sayısının standardı yok. Herbir kırılımın altında ve dolayısı ile üstünde mutlaka boş birer satır var.
Benim yapmak istediğim activecell dolu satırlardan herhangi bir hücrede iken, activecell'in üstünde ve altında bulunan
boş satırlara kadar olan aradaki (A?:C?) hücrelerini seçsin.


Emekleriniz için şimdiden sağolun.
Seyit Tiken' Alıntı:
Sub BosSatirlariSec() Dim ws As Worksheet Dim seciliHucre As Range Dim rowUp As Long, rowDown As Long Dim col As Long Dim secimAlani As Range Set ws = ActiveSheet Set seciliHucre = ActiveCell If Not Intersect(seciliHucre, ws.Range("A:C")) Is Nothing And seciliHucre.Value <> "" Then col = seciliHucre.Column rowUp = seciliHucre.Row Do While ws.Cells(rowUp, col).Value <> "" And rowUp > 1 rowUp = rowUp - 1 Loop rowDown = seciliHucre.Row Do While ws.Cells(rowDown, col).Value <> "" And rowDown < ws.Rows.Count rowDown = rowDown + 1 Loop If ws.Cells(rowUp, col).Value = "" And ws.Cells(rowDown, col).Value = "" Then Set secimAlani = Union(ws.Rows(rowUp), ws.Rows(rowDown)) secimAlani.Select ElseIf ws.Cells(rowUp, col).Value = "" Then ws.Rows(rowUp).Select ElseIf ws.Cells(rowDown, col).Value = "" Then ws.Rows(rowDown).Select Else MsgBox "Üstte veya altta boş satır bulunamadı.", vbInformation, "Bilgi" End If Else MsgBox "Lütfen A, B veya C sütunlarında yer alan DOLU bir hücre seçin", vbExclamation, "Geçersiz Seçim" End If End Sub
Genişletmek için tıkla ...
Seyit Hocam sizi çok yordum biliyorum

Sub BosSatirlariSec() değil de
Sub DoluSatirlariSec() desek daha doğru olacak
Kodlar dolu olan satırları değil, alt ve üstteki boş satırları seçiyor. Ben dolu olanları seçmek istiyorum.

Ayrıca A,B, C kolonu yerine örneğin D kolonunda seçim yaparsam kod çalışıyor ve
MsgBox "Lütfen A, B veya C sütunlarında yer alan DOLU bir hücre seçin", vbExclamation, "Geçersiz Seçim"
Mesajını alıyorum

Ancak seçilmiş olarak gelen alt/üst boş satırlar soldan sağa ilk kolondan son kolona kadar seçiliyor.
Ben sadece A,B,C kolonlarında dolu olan aralığı seçmek istiyorum.

Müsait olduğunuzda tekrar bakabilirmisiniz.

Teşekkürler
 
Bu şekilde bir deneyin!
Kod: 
Sub SadeceDoluHucreleriSec()
Dim ws As Worksheet
Dim sonSatir As Long
Dim aralik As Range
Set ws = ActiveSheet
On Error Resume Next
sonSatir = ws.Range("A:C").Find(What:="*", _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
On Error GoTo 0
If sonSatir = 0 Then
MsgBox "Belirtilen sütunlarda veri bulunamadı.", vbExclamation, "Uyarı"
Exit Sub
End If
Set aralik = ws.Range("A1:C" & sonSatir)
On Error Resume Next
aralik.SpecialCells(xlCellTypeConstants).Select
If Err.Number <> 0 Then
MsgBox "Seçilecek dolu hücre bulunamadı", vbInformation, "Bilgi"
End If
On Error GoTo 0
End Sub
 
Birde böyle deneyin!
Kod: 
[a:c].SpecialCells(2, 23).Select
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst