Adresi bulunan hücrenin sağındaki hücrenin içeriği

[mozdem]

Sub bul()
ad = InputBox("aranacak değeri yazınız.", "DEĞER", "")
If ad = "" Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
sut = 3
Worksheets(ActiveSheet.Name).Range("A35000").ClearContents
For r = 1 To ActiveWorkbook.Sheets.Count

If ActiveSheet.Name <> Sheets(r).Name _
And Sheets(r).Name <> "E_Sistemi" _
And Sheets(r).Name <> "Deneme" Then

deger = Sheets(r).Name

Set d = Worksheets(deger).Cells.Find(ad, LookIn:=xlValues)

If Not d Is Nothing Then
firstAddress = d.Address

Do
'd.Interior.ColorIndex = 3 'buradaki sayı renkleri göstermektedir.
Worksheets(ActiveSheet.Name).Cells(sut, 1).Value = Sheets(r).Name ' & " Sayfa adı"
Worksheets(ActiveSheet.Name).Cells(sut, 2).Value = d.Address 'Hücre Adresi
Worksheets(ActiveSheet.Name).Cells(sut, 3).Value = d 'Bulunan
Worksheets(ActiveSheet.Name).Cells(sut, 4).Value = ad 'Aranan

'------------------------------------

'Worksheets(ActiveSheet.Name).Cells(sut, 5).Value = SolHücre ' Bulunan adresteki hücrenin solundaki hücre içeriği
'Worksheets(ActiveSheet.Name).Cells(sut, 6).Value = SagHucre ' Bulunan adresteki hücrenin sağındaki hücre içeriği

'--------------------------------------

sut = sut + 1
Set d = Worksheets(deger).Cells.FindNext(d)
Loop While Not d Is Nothing And d.Address <> firstAddress

End If
End If

Next r

MsgBox sut - 3 & " adet bulundu"
End Sub


Yukarıdaki Kod içinde
'----------

'---------
arasına yazmak istediğim kodları yazamadım.
Bulunan hücre adresinin sağındaki ve solundaki verileri aktif sayfaya yazdırmak istiyorum.

kod olarak ne yazmalıyım.

bu vesile ile Bu kodlardaki emeğinden dolayı halit3 ' teşekkür ederim.

 

[halit3]

bunları denermisiniz

Worksheets(ActiveSheet.Name).Cells(sut, 5).Value = Worksheets(deger).Cells(d.Row, d.Column - 1)
Worksheets(ActiveSheet.Name).Cells(sut, 6).Value = Worksheets(deger).Cells(d.Row, d.Column + 1)

 

[mozdem]

Teşekkür

bunları denermisiniz

Teşekkürler hocam, Tamam. Ellerinize sağlık.

 

[halit3]

iyi çalışlmalar

 

[mozdem]

F sütunda arasın

iyi çalışlmalar

Set d = Worksheets(deger).Cells.Find(ad, LookIn:=xlValues)

hocam yukarıdaki kodlarda aramanın yalnızca hangi sayfada yapıyorsa örneğin F sütununda arama yapsın.

Set d = Worksheets(deger).Cells.Columns("F:f").Find(ad, LookIn:=xlValues)
Kodlar birbirine girdi yapamadım.

Teşekkürler.

 

[mozdem]

Set d = Worksheets(deger).Cells.Find(ad, LookIn:=xlValues)

hocam yukarıdaki kodlarda aramanın yalnızca hangi sayfada yapıyorsa örneğin F sütununda arama yapsın.

Set d = Worksheets(deger).Cells.Columns("F:f").Find(ad, LookIn:=xlValues)
Kodlar birbirine girdi yapamadım.

Teşekkürler.

Sanırım yaptım
Set d = Worksheets(deger).Cells.Find(ad, LookIn:=xlValues)
ile
Set d = Worksheets(deger).Cells.FindNext(d)

satırlarına
Set d = Worksheets(deger).Columns("F:F").Find(ad, LookIn:=xlValues)
Set d = Worksheets(deger).Columns("F:F").FindNext(d)

şeklinde değiştirdim. bu zamana kadar yalnızca ilk satır ile uğraştım. Onun için olmamıştı

Şimdi yeni bir soru ile karşılaştım.

Aranan değer sayısal değer ve örneğin 1

içinde 1 bulunan tüm sayıları buluyor örneğin 5124,125, 15 vs . yani tam değeri nasıl bulabilirim.

yardımcı olabilirmisiniz.

 

[halit3]

Sanırım yaptım
Set d = Worksheets(deger).Cells.Find(ad, LookIn:=xlValues)
ile
Set d = Worksheets(deger).Cells.FindNext(d)

satırlarına
Set d = Worksheets(deger).Columns("F:F").Find(ad, LookIn:=xlValues)
Set d = Worksheets(deger).Columns("F:F").FindNext(d)

şeklinde değiştirdim. bu zamana kadar yalnızca ilk satır ile uğraştım. Onun için olmamıştı

Şimdi yeni bir soru ile karşılaştım.

Aranan değer sayısal değer ve örneğin 1

içinde 1 bulunan tüm sayıları buluyor örneğin 5124,125, 15 vs . yani tam değeri nasıl bulabilirim.

yardımcı olabilirmisiniz.

bunları gerekli yerlere koy

önce aranan değerin sayımı yoksa metinmi olduğunu bulalım

If IsNumeric(ad) = True Then
ad = Val(ad)
Else
ad = ad
End If

kodun bir kısmını koyuyorum altı ve üstünü kendine göre yaparsın

If Not d Is Nothing Then
firstAddress = d.Address
Do
If Worksheets(deger).Cells(d.Row, d.Column).Value = ad Then
'd.Interior.ColorIndex = 3 'buradaki sayı renkleri göstermektedir.
Worksheets(ActiveSheet.Name).Cells(sut, 1).Value = Sheets(r).Name
Worksheets(ActiveSheet.Name).Cells(sut, 2).Value = d.Address
Worksheets(ActiveSheet.Name).Cells(sut, 3).Value = d.Row
Worksheets(ActiveSheet.Name).Cells(sut, 4).Value = d.Column
Worksheets(ActiveSheet.Name).Cells(sut, 5).Value = d.Value
sut = sut + 1
End If
Set d = Worksheets(deger).Cells.FindNext(d)

 

[halit3]

örnek dosya gönderiyorum kendine göre uyarla

 

[mozdem]

Teşekkürler

Halit3 hocam çok teşekkür, süper güzel olmuş.

Kolay gelsin, eline sağlık.

 

[halit3]

Halit3 hocam çok teşekkür, süper güzel olmuş.

Kolay gelsin, eline sağlık.

iyi çalımalar