Açık excel sayfalarında düşey arama .

mustilem23

Altın Üye
Katılım
29 Ekim 2010
Mesajlar
365
Excel Vers. ve Dili
Microsoft Office 365 ProPlus 64 bit
Altın Üyelik Bitiş Tarihi
31-05-2024
Merhaba ,

Sürekli olarak düşey arama yaptığım bir durumum mevcut .
Şöyle ki ; Müşteriden gelen katalog numaralarını excele alıyorum ve akabinde makinenin iş emrinde var mı yok mu sorgulamam gerekiyor , kullandığımız program her seferin de çıktı excelin de isim değişiyor ve bazı durumlarda birden fazla makine dosya excelin de sorgulama ve arama yapmak durumda kalıyorum .

bu işlemi excel de makro yapılabilmesi mümkün müdür.

AKTIF EXCELDE BULMA .xls dosyamın a sütunun satırında bulunan sayıları açık olan tüm excel sayfalarında aratıp diğer sütuna hani excel sayfasında bulduğunu yazdırabilir miyiz.
 

Ekli dosyalar

mustilem23

Altın Üye
Katılım
29 Ekim 2010
Mesajlar
365
Excel Vers. ve Dili
Microsoft Office 365 ProPlus 64 bit
Altın Üyelik Bitiş Tarihi
31-05-2024
Arkadaşlar böyle birşey yapabilmek mümkün müdür.
 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,196
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Merhaba,

Bu şekilde deneyin.
Kod:
Sub bul()

    Dim b As String, j As Byte, i As Long, a As String, d

    b = ThisWorkbook.Name
    
    j = 2
    For Each d In Workbooks
        If d.Name <> b Then
            a = "'" & d.Name & "'!B:D"
            For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
                Cells(i, j) = Evaluate("=IFERROR(VLOOKUP(" & Cells(i, "A") & "," & a & ",2,0),"""")")
            Next i
            j = j + 1
        End If
    Next d

End Sub
 

mustilem23

Altın Üye
Katılım
29 Ekim 2010
Mesajlar
365
Excel Vers. ve Dili
Microsoft Office 365 ProPlus 64 bit
Altın Üyelik Bitiş Tarihi
31-05-2024
Üstadım eline sağlık ufkumu açtın , lakin tek eksiği bulduğu excelin ismini yazmıyor.,
İşlemi yaparken B sütunu siliyor oraya yazdırabilir miyiz.açık ve aktif 3 excelde deneme yaptım.
 

Ekli dosyalar

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,196
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Bu şekilde deneyin.
Kod:
Sub bul()

    Dim b As String, j As Byte, i As Long, a As String, d
    
    Range(Cells(1, "B"), Cells(Rows.Count, Columns.Count)).ClearContents

    b = ThisWorkbook.Name
    
    j = 3
    For Each d In Workbooks
        If d.Name <> b Then
            a = "'" & d.Name & "'!B:D"
            For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
                Cells(i, "B") = Cells(i, "B") & " " & d.Name
                Cells(i, j) = Evaluate("=IFERROR(VLOOKUP(" & Cells(i, "A") & "," & a & ",2,0),"""")")
            Next i
            j = j + 1
        End If
    Next d

End Sub
 

mustilem23

Altın Üye
Katılım
29 Ekim 2010
Mesajlar
365
Excel Vers. ve Dili
Microsoft Office 365 ProPlus 64 bit
Altın Üyelik Bitiş Tarihi
31-05-2024
üstada eline sağlık çok teşekkür ederim.
 
Üst