Bul makrosunda düzenleme

[1Al2Ver]

Merhaba,

Aşağıdaki kod ile aranılan değeri bulabiliyorum, ancak aranılan değer A1:A31 aralığından daha aşağıda ise ekranda görülmemektedir,

İsteğim ; Aranılan değer hangi hücre/hücrelerde ise ekranda görebileyim,

Örneğin bulunan değer A55:A70 aralığında ise PgDn yapmadan ekranda görülebilsin,

Teşekkür ederim.

Sub BUL()
yer = WorksheetFunction.CountA(Columns("A"))
Range("A1:A1300").Interior.ColorIndex = 2
ad = InputBox("aranacak değeri yazınız.", "DEĞER", "")
If ad = "" Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
sat = 0

With Range("A1:A1300")
Set d = .Find(ad, LookIn:=xlValues, lookat:=xlWhole)
If Not d Is Nothing Then
firstAddress = d.Address
Do
d.Interior.ColorIndex = 3 'buradaki sayı, renkleri göstermektedir.
sat = sat + 1
Set d = .FindNext(d)
Loop While Not d Is Nothing And d.Address <> firstAddress
End If
End With

MsgBox sat & " adet bulundu"

End Sub

 

[1Al2Ver]

Merhaba,

Çözüm rica ediyorum,

Teşekkür ederim.

 

[uzmanamele]

Merhaba,

Çözüm rica ediyorum,

Teşekkür ederim.

merhaba

örnek dosya rica ediyorum.

 

[Orion1]

o nasıl olacak
1 ile 1300 arasında 200 tane bulunursa nasıl olacak
5 şer satır aralıkla bulunduğunu farzedelim.
Diğerlerini gizlesen bile yinede 200 satır ekrana sığımaz.

 

[1Al2Ver]

o nasıl olacak
1 ile 1300 arasında 200 tane bulunursa nasıl olacak
5 şer satır aralıkla bulunduğunu farzedelim.
Diğerlerini gizlesen bile yinede 200 satır ekrana sığımaz.

Merhaba Sayın Evren Gizlen,

Evet haklısınız, ayrıca ilginiz ve uyarınız için teşekkür ederim, şöyle açıklamaya çalışayım ;

Arayıp bulacağı veri adedi 11, yani 11 satır ve alt alta sıralılar,

Örneğin ;

A1:A11'de Ayşe , A12:A22'de Mustafa, A23:A33'de Süleyman, A34:A44'te Mehmet olsun,

Makro ile aranılan değer Mehmet ise, A34:A44 aralığı görmek arzusundayım,

Teşekkür ederim.

 

[Orion1]

Merhaba Sayın Evren Gizlen,

Evet haklısınız, ayrıca ilginiz ve uyarınız için teşekkür ederim, şöyle açıklamaya çalışayım ;

Arayıp bulacağı veri adedi 11, yani 11 satır ve alt alta sıralılar,

Örneğin ;

A1:A11'de Ayşe , A12:A22'de Mustafa, A23:A33'de Süleyman, A34:A44'te Mehmet olsun,

Makro ile aranılan değer Mehmet ise, A34:A44 aralığı görmek arzusundayım,

Teşekkür ederim.

Yapan olmazsa yarın yaparım.

 

[1Al2Ver]

Yapan olmazsa yarın yaparım.

Sayın Evren Gizlen merhaba,

Sorun değil, zamanım var, teşekkür ederim.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub BUL_GÖSTER()
    Dim SATIR As Long, ARANACAK_DEĞER As Variant
    
    ARANACAK_DEĞER = InputBox("Aranacak değeri giriniz !")
    If ARANACAK_DEĞER = False Or ARANACAK_DEĞER = Empty Then Exit Sub
    
    If WorksheetFunction.CountIf(Range("A:A"), ARANACAK_DEĞER) > 0 Then
        SATIR = WorksheetFunction.Match(ARANACAK_DEĞER, Range("A:A"), 0)
            If SATIR > 0 Then
                Cells.EntireRow.Hidden = True
                Range("A" & SATIR & ":A" & SATIR + 10).EntireRow.Hidden = False
            End If
            Range("A1").Select
    Else
        Cells.EntireRow.Hidden = False
        MsgBox "Aradığınız değer bulunamamıştır !", vbExclamation
    End If
End Sub

 

[halit3]

alternatif olarak aşağıdaki kodu denermisiniz.

Sub BUL()
Range("A1").Select
Range("A:A").Interior.ColorIndex = xlNone
ad = InputBox("aranacak değeri yazınız.", "DEĞER", "")
If ad = "" Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
sat = 0
yer = ""
With Range("A:A")
Set d = .Find(ad, LookIn:=xlValues, lookat:=xlWhole)
If Not d Is Nothing Then
firstAddress = d.Address
Do
d.Interior.ColorIndex = 3 'buradaki sayı, renkleri göstermektedir.
d.Select
'MsgBox ad & " bulunan değerin adresi " & d.Address(False, False)
If yer <> "" Then
ekle = ","
Else
ekle = ""
End If
yer = yer & ekle & d.Address(False, False)
yer1 = yer1 & d.Address(False, False) & Chr(10)
sat = sat + 1
Set d = .FindNext(d)
Loop While Not d Is Nothing And d.Address <> firstAddress
End If
End With
If sat = 0 Then
MsgBox ad & " değeri bulunamamıştır"
Exit Sub
End If
Range(yer).Select
MsgBox yer1 & Chr(10) & sat & " adet bulundu", vbInformation, "Hücrelerin numaraları"

End Sub

 

[1Al2Ver]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub BUL_GÖSTER()
    Dim SATIR As Long, ARANACAK_DEĞER As Variant
    
    ARANACAK_DEĞER = InputBox("Aranacak değeri giriniz !")
    If ARANACAK_DEĞER = False Or ARANACAK_DEĞER = Empty Then Exit Sub
    
    If WorksheetFunction.CountIf(Range("A:A"), ARANACAK_DEĞER) > 0 Then
        SATIR = WorksheetFunction.Match(ARANACAK_DEĞER, Range("A:A"), 0)
            If SATIR > 0 Then
                Cells.EntireRow.Hidden = True
                Range("A" & SATIR & ":A" & SATIR + 10).EntireRow.Hidden = False
            End If
            Range("A1").Select
    Else
        Cells.EntireRow.Hidden = False
        MsgBox "Aradığınız değer bulunamamıştır !", vbExclamation
    End If
End Sub

Sayın Korhan Ayhan merhaba,

Çözüm için çok teşekkür ederim,

Saygılarımla.

 

[1Al2Ver]

alternatif olarak aşağıdaki kodu denermisiniz.

Sayın halit3 merhaba,

Alternatif çözüm için çok teşekkür ederim,

Saygılarımla.