Excel fınd makrosu oluşturma

[sakaryafirat]

Merhaba arkadaşlar.UserForm üzerinden bir textbox aracılığıyla girilen verileri tüm çalışma kitabında bulacak bir bakıma CTRL+F ile aynı ya da benzer işleve sahip bir makro oluşturmak istiyorum.Bu konuda yardımlarınızı bekliyorum.Teşekkürler.

 

[Huseyinkis]

Merhaba arkadaşlar.UserForm üzerinden bir textbox aracılığıyla girilen verileri tüm çalışma kitabında bulacak bir bakıma CTRL+F ile aynı ya da benzer işleve sahip bir makro oluşturmak istiyorum.Bu konuda yardımlarınızı bekliyorum.Teşekkürler.

ekteki linki incelermisiniz.

http://www.excel.web.tr/f48/combobox-la-textbox-un-yazacaoy-hucreyi-belirlemek-t96380.html#post526070

 

[sakaryafirat]

Hüseyin bey inceledim tabi benimki biraz farklı bir durum.Tüm çalışma kitabında arama yapmak istiyorum.Teşekkürler.

 

[Huseyinkis]

Hüseyin bey inceledim tabi benimki biraz farklı bir durum.Tüm çalışma kitabında arama yapmak istiyorum.Teşekkürler.

Merhaba Kombinasyonlarla ilgili daha once yapılmış bir formul var. Formul alıntıdır ama kimden aldım hatırlamıyorum

en yakın değeri getirmek için kullanılmış sadeleştire bilirseniz sanırım işime yarar.

Sadeleştirmede sorun yaşarsanız yardım edebilirim.fakat ay sonu raporlama işleri nedeniyle biraz yogun işler.
Gelen olarak baktığımda aşağıdaki formul sizin için yeterli gibi.

Bu dosyada sayfa numaralarına 1 2 3 4 5 diye isim verildiği için 3 to Sheets.Count formulu sayfa isimlerinde sorun yaşamaz ama metinsel sayfalar varsa ekleme yapılması lazım mesala bir sayfaya a1 den başlayarak sayfa isimleri verilip oradan 1, 2, 3. sayfa isimleri getirilebilir.

[B]
For X = 3 To Sheets.Count
Set BUL = Sheets(X).Cells.Find(ARANAN)
If Not BUL Is Nothing Then
[/B]

Sub HANGİ_KOMBİNASYONLAR_ARANAN_DEĞERİ_VERİYOR()
    Application.Calculation = xlCalculationManual
    Sheets("RAPOR").Select
    [A2:B65536].ClearContents
    ARANAN = Sheets("VERİ").[B2]
    SATIR = 2
    For X = 3 To Sheets.Count
    Set BUL = Sheets(X).Cells.Find(ARANAN)
    If Not BUL Is Nothing Then
    ADRES = BUL.Address
    Do
    ARANAN_SATIR = BUL.Row
    ARANAN_SÜTUN = BUL.Column
    Cells(SATIR, 1) = Sheets(X).Cells(ARANAN_SATIR, ARANAN_SÜTUN - 1)
    Cells(SATIR, 2) = ARANAN
    SATIR = SATIR + 1
    Set BUL = Sheets(X).Cells.FindNext(BUL)
    Loop While Not BUL Is Nothing And BUL.Address <> ADRES
    End If
    Next
    EN_YAKIN_1 = Evaluate("=MAX(IF('1'!B2:IV65536<VERİ!B2,'1'!B2:IV65536))")
    EN_YAKIN_2 = Evaluate("=MAX(IF('2'!B2:IV65536<VERİ!B2,'2'!B2:IV65536))")
    EN_YAKIN_3 = Evaluate("=MAX(IF('3'!B2:IV65536<VERİ!B2,'3'!B2:IV65536))")
    EN_YAKIN_4 = Evaluate("=MAX(IF('4'!B2:IV65536<VERİ!B2,'4'!B2:IV65536))")
    EN_YAKIN_5 = Evaluate("=MAX(IF('5'!B2:IV65536<VERİ!B2,'5'!B2:IV65536))")
    EN_YAKIN_6 = Evaluate("=MAX(IF('6'!B2:IV65536<VERİ!B2,'6'!B2:IV65536))")
    EN_YAKIN_7 = Evaluate("=MAX(IF('7'!B2:IV65536<VERİ!B2,'7'!B2:IV65536))")
    EN_YAKIN_8 = Evaluate("=MAX(IF('8'!B2:IV65536<VERİ!B2,'8'!B2:IV65536))")
    EN_YAKIN_9 = Evaluate("=MAX(IF('9'!B2:IV65536<VERİ!B2,'9'!B2:IV65536))")
    EN_YAKIN_10 = Evaluate("=MAX(IF('10'!B2:IV65536<VERİ!B2,'10'!B2:IV65536))")
    EN_YAKIN_11 = Evaluate("=MAX(IF('11'!B2:IV65536<VERİ!B2,'11'!B2:IV65536))")
    EN_YAKIN_12 = Evaluate("=MAX(IF('12'!B2:IV65536<VERİ!B2,'12'!B2:IV65536))")
    EN_YAKIN_13 = Evaluate("=MAX(IF('13'!B2:IV65536<VERİ!B2,'13'!B2:IV65536))")
    EN_YAKIN_14 = Evaluate("=MAX(IF('14'!B2:IV65536<VERİ!B2,'14'!B2:IV65536))")
    EN_YAKIN_15 = Evaluate("=MAX(IF('15'!B2:IV65536<VERİ!B2,'15'!B2:IV65536))")
    EN_YAKIN_16 = Evaluate("=MAX(IF('16'!B2:IV65536<VERİ!B2,'16'!B2:IV65536))")
    EN_YAKIN_17 = Evaluate("=MAX(IF('17'!B2:IV65536<VERİ!B2,'17'!B2:IV65536))")
    EN_YAKIN_18 = Evaluate("=MAX(IF('18'!B2:IV65536<VERİ!B2,'18'!B2:IV65536))")
    EN_YAKIN_19 = Evaluate("=MAX(IF('19'!B2:IV65536<VERİ!B2,'19'!B2:IV65536))")
    EN_YAKIN_20 = Evaluate("=MAX(IF('20'!B2:IV65536<VERİ!B2,'20'!B2:IV65536))")
    EN_YAKIN = WorksheetFunction.Max(EN_YAKIN_1, EN_YAKIN_2, EN_YAKIN_3, EN_YAKIN_4, EN_YAKIN_5, EN_YAKIN_6, EN_YAKIN_7, EN_YAKIN_8, EN_YAKIN_9, EN_YAKIN_10, EN_YAKIN_11, EN_YAKIN_12, EN_YAKIN_13, EN_YAKIN_14, EN_YAKIN_15, EN_YAKIN_16, EN_YAKIN_17, EN_YAKIN_18, EN_YAKIN_19, EN_YAKIN_20)
    For X = 3 To Sheets.Count
    Set BUL = Sheets(X).Cells.Find(EN_YAKIN)
    If Not BUL Is Nothing Then
    ADRES = BUL.Address
    Do
    EN_YAKIN_SATIR = BUL.Row
    EN_YAKIN_SÜTUN = BUL.Column
    Cells(SATIR, 1) = Sheets(X).Cells(EN_YAKIN_SATIR, EN_YAKIN_SÜTUN - 1)
    Cells(SATIR, 2) = EN_YAKIN
    SATIR = SATIR + 1
    Set BUL = Sheets(X).Cells.FindNext(BUL)
    Loop While Not BUL Is Nothing And BUL.Address <> ADRES
    End If
    Next
    Cells.EntireColumn.AutoFit
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Toplam " & [A65536].End(3).Row - 1 & " adet kombinasyon listelenmiştir."
End Sub

 

[sakaryafirat]

Hocam benim yapacağım programda sayfa isimleri metinsel.Ama yine de ilginiz ve cevaplarınız için çok teşekkür ediyorum.Ben araştırmalara devam edeceğim.Siz de yine buna benzer kodlar vs. bulupta yardımcı olursanız çok memnun olurum.Sağolun iyi çalışmalar.

 

[mancubus]

aşağıdaki kod kitaptaki tüm sayfalarda "eski" ifadesini arar ve bulduğunda "yeni" ifadesi ile değiştirir.
MsgBox ile başlayan satır kullanılır ise aranan değerin bulunduğu bütün hücreleri sayfa ismi ile birlikte görüntüler.
siz kırmızı font ile belirttiği satır yerine yapmak istediklerinizi uyarlayabilirsiniz.
aradığınız metnin tam olarak eşleşmesini (xlWhole) istediğinizde birinci seçeneği, kısmen eşleşmesi de isteniyorsa ikinci seçeneği (xlPart) kullanın.

Option Explicit

Sub bul()

Dim wks As Worksheet
Dim cll As Range
Dim ara As String, ilkAdres As String

Application.ScreenUpdating = False

ara = "eski"

For Each wks In Worksheets
    With wks.UsedRange
        Set cll = .Find(What:=ara, after:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        'Set cll = .Find(What:=ara, after:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
            [COLOR="Blue"]xlPart[/COLOR], SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not cll Is Nothing Then
            ilkAdres = cll.Address
            Do
                [COLOR="Red"]cll.Value = "yeni"[/COLOR]
                '[COLOR="#ff0000"]MsgBox wks.Name & " - " & cll.Address[/COLOR]
                Set cll = .FindNext(cll)
                If cll Is Nothing Then
                    Exit Do
                Else
                    If cll.Address = ilkAdres Then
                        Exit Do
                    End If
                End If
            Loop
        End If
    End With
Next

Application.ScreenUpdating = True

End Sub

 

[sakaryafirat]

Hocam teşekkürler.Bu kod gerçekten çok iş görür.Yalnız şöyle bir ricam olacak.Bu kod üzerinde değişiklik yaparak; bulunan verileri msgboxtan göstermek yerine arama yapıldıktan sonra çalışma kitabı üzerinden göstermek aynı CTRL+F gibi yapmak mümkün müdür? Mesela aranıpta bulunan tüm veriler aynı renkte görülsün ve sonraki diyip diğer veriyi görebilelim.Teşekkürler.