çalışma kitabının tüm sayfalarında arama

myway

Altın Üye
Katılım
24 Ağustos 2004
Mesajlar
29
Altın Üyelik Bitiş Tarihi
08-04-2026
Merhaba arkadaşlar;
Çalışma kitabının her sayfasının yalnızca C kolonunda bir veri arayıp, bulduğu hücreleri msgbox ile bildiren makro nasıl olabilir?
 

Kemal Demir

Özel Üye
Katılım
29 Temmuz 2004
Mesajlar
2,108
Öncelikle Forumumuza Hoşgeldiniz.

Kod:
aranacakveri=inputbox("Arancal Veriyi Giriniz")
For x = 1 To Sheets.Count
Sheets(x).Select
adres = Columns(3).Find(aranacakveri).Address
MsgBox adres
Next
Yukarıdaki kod zannedersem işinizi görecektir.
 
Son düzenleme:

myway

Altın Üye
Katılım
24 Ağustos 2004
Mesajlar
29
Altın Üyelik Bitiş Tarihi
08-04-2026
Öncelikle Forumumuza Hoşgeldiniz.

Kod:
aranacakveri=inputbox("Arancal Veriyi Giriniz")
For x = 1 To Sheets.Count
Sheets(x).Select
adres = Columns(3).Find(aranacakveri).Address
MsgBox adres
Next
Yukarıdaki kod zannedersem işinizi görecektir.
ilgine teşekkür ederim..
vermiş olduğun makro sütundaki ilk bulduğu veriyi bildiriyor.
altındaki satırdakini bildirmiyor..
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,666
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Aşağıdaki kodu denermisiniz.

Kod:
Sub ARA_BİLDİR()
    KRİTER = Application.InputBox("Lütfen aramak istediğiniz veriyi giriniz.", "Arama")
    If KRİTER = "" Or KRİTER = False Then Exit Sub
    For X = 1 To Sheets.Count
    ADET = WorksheetFunction.CountIf(Sheets(X).Columns("C"), KRİTER)
    Set BUL = Sheets(X).Columns("C").Find(KRİTER, LookAt:=xlWhole)
    If Not BUL Is Nothing Then
    ADRES = BUL.Address
    Do
    If SAY = ADET Then GoTo Devam
    MsgBox Sheets(X).Name & vbCrLf & BUL.Address(0, 0)
    SAY = SAY + 1
    Set BUL = Sheets(X).Columns("C").FindNext(BUL)
    Loop While Not BUL Is Nothing And BUL.Address <> ADRES
    End If
Devam:
    Next
    If SAY = 0 Then MsgBox "Aranan veri bulunamam&#305;&#351;t&#305;r !", vbExclamation, "Dikkat !"
End Sub
 

myway

Altın Üye
Katılım
24 Ağustos 2004
Mesajlar
29
Altın Üyelik Bitiş Tarihi
08-04-2026
Te&#351;ekk&#252;r ederim...
 
Üst