Kapalı Excel Kitabındaki sayfada arama yapma

kykbt

Altın Üye
Katılım
12 Nisan 2006
Mesajlar
284
Excel Vers. ve Dili
Office 2003
Office 2007
Altın Üyelik Bitiş Tarihi
29-05-2025
Arkadaşlar Merhaba

Yapmak istediğim Bulunduğum calışma kitabında ki bi sayfa daki herhangi bir hücreye yazdığım satıcı adını (yazıp enter dediğimde)
Kapalı olan başka bir çalışma kitabının adı (SATICILAR) olsun HIRDAVATCILAR adlı sayfasının A sutununda arama yapıp eğer var ise karşılık gelen B sutunundaki değeri göstersin istiyorum
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Excel4 makro kulanılarak yapıldı.
Her iki dosyada ayni klasörün içinde olmalı.SATICILAR dosyasında ilk veri 1nci satırdan başlamalı ve hücreler arasında boşluk olmamamalı.
Kullandığın ız dosyadaki sayfanın kod bölümüne aşaığıdaki kodları yazın.
A sütunna bir değer yazdığınızda b sürununa diğer dosyadaki b sütunundaki değeri yazar.:cool:
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
On Error Resume Next
If Target.Value = Empty Then Exit Sub
sonsat = Application.ExecuteExcel4Macro("CountA('" & ThisWorkbook.Path & "\[SATICILAR]HIRDAVATCILAR'!C1)")
For i = 1 To sonsat
    deg = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[SATICILAR]HIRDAVATCILAR'!R" & i & "C1")
    If Target.Value = deg Then
        Target.Offset(0, 1).Value = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[SATICILAR]HIRDAVATCILAR'!R" & i & "C2")
        Exit For
    End If
Next i

End Sub
 

kykbt

Altın Üye
Katılım
12 Nisan 2006
Mesajlar
284
Excel Vers. ve Dili
Office 2003
Office 2007
Altın Üyelik Bitiş Tarihi
29-05-2025
Hocam ilgine teşekkür ediyorum.
Sanırım yanlış anlaşıldı ben bulunduğum sayfada herhangi bir hücreye yazdığım şeyi yani sadece a sutununa değil,
SATICILAR kitabı içindeki HIRDAVATCILAR sayfasının A sutununda arayıp kitabtaki A sutununda bul du ise buna karşılık gelen B hücresindeki değeri bir UYARI olarak versin istiyorum
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Hocam ilgine teşekkür ediyorum.
Sanırım yanlış anlaşıldı ben bulunduğum sayfada herhangi bir hücreye yazdığım şeyi yani sadece a sutununa değil,
SATICILAR kitabı içindeki HIRDAVATCILAR sayfasının A sutununda arayıp kitabtaki A sutununda bul du ise buna karşılık gelen B hücresindeki değeri bir UYARI olarak versin istiyorum
O zaman öncekini silin alta yazdığımı kullanın.:cool:
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
On Error Resume Next
If Target.Value = Empty Then Exit Sub
sonsat = Application.ExecuteExcel4Macro("CountA('" & ThisWorkbook.Path & "\[SATICILAR]HIRDAVATCILAR'!C1)")
For i = 1 To sonsat
    deg = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[SATICILAR]HIRDAVATCILAR'!R" & i & "C1")
    If Target.Value = deg Then
        MsgBox "[ " & Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[SATICILAR]HIRDAVATCILAR'!R" & i & "C2") _
        & " ] SATICILAR dosyasında HIRDAVATCILAR SAYFASINDA A SÜTUNUNDA VARDIR..!!", vbCritical, "UYARI"
        Exit For
    End If
Next i
End Sub
 

kykbt

Altın Üye
Katılım
12 Nisan 2006
Mesajlar
284
Excel Vers. ve Dili
Office 2003
Office 2007
Altın Üyelik Bitiş Tarihi
29-05-2025
..................

Hocam ne demeli bilemiyorum tam istediğim.

KOCAMAN TEŞEKKÜRLER.....
 
Katılım
17 Ocak 2008
Mesajlar
183
Excel Vers. ve Dili
2003
O zaman öncekini silin alta yazdığımı kullanın.:cool:
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
On Error Resume Next
If Target.Value = Empty Then Exit Sub
sonsat = Application.ExecuteExcel4Macro("CountA('" & ThisWorkbook.Path & "\[SATICILAR]HIRDAVATCILAR'!C1)")
For i = 1 To sonsat
    deg = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[SATICILAR]HIRDAVATCILAR'!R" & i & "C1")
    If Target.Value = deg Then
        MsgBox "[ " & Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[SATICILAR]HIRDAVATCILAR'!R" & i & "C2") _
        & " ] SATICILAR dosyasında HIRDAVATCILAR SAYFASINDA A SÜTUNUNDA VARDIR..!!", vbCritical, "UYARI"
        Exit For
    End If
Next i
End Sub
Merhaba arkadaşlar yukarıdaki koda benzer bir örnek rica ediyorum. Benim isteğim de buna yakın. Bulunduğum çalışma kitabında herhangi bir hücreye sayı girdiğimde , O sayıyı kapalı B.xls çalışma kitabının Sayfa 1 in A5:A2000
aralığında arayıp aranan sayı yoksa "kayıt yok", şayet aranan sayı varsa " Sayfa 1in B sütununda aranan sayılara karşılık gelen tarihleri listelemesi
A sütununda aynı sayıdan birden fazla olma durumu var bu durum da aranan sayı birden fazla ise b sütunundaki tarihleride arama sonucunda yazması gerekir
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Merhaba arkadaşlar yukarıdaki koda benzer bir örnek rica ediyorum. Benim isteğim de buna yakın. Bulunduğum çalışma kitabında herhangi bir hücreye sayı girdiğimde , O sayıyı kapalı B.xls çalışma kitabının Sayfa 1 in A5:A2000
aralığında arayıp aranan sayı yoksa "kayıt yok", şayet aranan sayı varsa " Sayfa 1in B sütununda aranan sayılara karşılık gelen tarihleri listelemesi
A sütununda aynı sayıdan birden fazla olma durumu var bu durum da aranan sayı birden fazla ise b sütunundaki tarihleride arama sonucunda yazması gerekir
Aşağıdaki kodları çalışma sayfasının kod bölümüne giriniz.
Dosya adını ve sayfa adını en başta koda giriniz.:cool:
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long,kapali_dosya as string,sayfa as string,sat as long
On Error Resume Next
range("C:C").clear
If Target.Value = Empty Then Exit Sub
kapali_dosya="Buraya dosya adını yazınız"
sayfa="Buraya sayfa adını yazınız"
sonsat = Application.ExecuteExcel4Macro("CountA('" & ThisWorkbook.Path & "\[" & kapali_dosya & "]" & sayfa & "'!C1)")
For i = 1 To sonsat
    deg = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[" &  kapali_dosya & "]" & sayfa & "'!R" & i & "C1")
    If Target.Value = deg Then
        sat=sat+1
        cells(sat,"C").value=Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[" & kapali_dosya & "]" & sayfa & "'!R" & i & "C2")
       
    End If
Next i
if sat = 0 then msgbox "Aranılan bulunamadı"
End Sub
 
Katılım
17 Ocak 2008
Mesajlar
183
Excel Vers. ve Dili
2003
Aşağıdaki kodları çalışma sayfasının kod bölümüne giriniz.
Dosya adını ve sayfa adını en başta koda giriniz.:cool:
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long,kapali_dosya as string,sayfa as string,sat as long
On Error Resume Next
range("C:C").clear
If Target.Value = Empty Then Exit Sub
kapali_dosya="Buraya dosya adını yazınız"
sayfa="Buraya sayfa adını yazınız"
sonsat = Application.ExecuteExcel4Macro("CountA('" & ThisWorkbook.Path & "\[" & kapali_dosya & "]" & sayfa & "'!C1)")
For i = 1 To sonsat
    deg = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[" &  kapali_dosya & "]" & sayfa & "'!R" & i & "C1")
    If Target.Value = deg Then
        sat=sat+1
        cells(sat,"C").value=Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[" & kapali_dosya & "]" & sayfa & "'!R" & i & "C2")
       
    End If
Next i
if sat = 0 then msgbox "Aranılan bulunamadı"
End Sub
Merhaba hocam emeğiniz için teşekkür ederim. Ancak bu haliyle işimi tam olarak görmüyor. eklediğim dosyada gerekli açıklamaları yaptım yazdığınız kodu
bu açıklamalr doğrultusunda revize etmeniz mümkün müdür?
 

Ekli dosyalar

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Dosyanız ektedir.:cool:
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, kapali_dosya As String, sayfa As String, sat As Long
Dim tar
On Error Resume Next
If Target.Value = Empty Then Exit Sub
kapali_dosya = "B.xls"
sayfa = "Sayfa1"
sonsat = Application.ExecuteExcel4Macro("CountA('" & ThisWorkbook.Path & "\[" & kapali_dosya & "]" & sayfa & "'!C2)")
For i = 1 To sonsat
    deg = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[" & kapali_dosya & "]" & sayfa & "'!R" & i & "C2")
    If CStr(Target.Value) = CStr(Right(deg, 10)) Then
        tar = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[" & kapali_dosya & "]" & sayfa & "'!R" & i & "C3")
         MsgBox Format(tar, "dd.mm.yyyy")
        Exit Sub
    End If
Next i
MsgBox "Aranılan bulunamadı"
End Sub
 

Ekli dosyalar

Katılım
17 Ocak 2008
Mesajlar
183
Excel Vers. ve Dili
2003
Hocam eline sağlık çok güzel olmuş. Sütunda aynı sayıdan birden fazla olması durumunda da diğer tarihlleri açılan pencerede alt alta listelesin istemiştim ama sanırım sorumu iyi anlatamadım bu haliylede işimi görür. Tekrar teşekkür ederim.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Hocam eline sağlık çok güzel olmuş. Sütunda aynı sayıdan birden fazla olması durumunda da diğer tarihlleri açılan pencerede alt alta listelesin istemiştim ama sanırım sorumu iyi anlatamadım bu haliylede işimi görür. Tekrar teşekkür ederim.
Dosyanız ektedir.:cool:
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, kapali_dosya As String, sayfa As String, sat As Long
Dim tar, myarr(), var As Boolean
On Error Resume Next
If Target.Value = Empty Then Exit Sub
kapali_dosya = "B.xls"
sayfa = "Sayfa1"
sonsat = Application.ExecuteExcel4Macro("CountA('" & ThisWorkbook.Path & "\[" & _
kapali_dosya & "]" & sayfa & "'!C2)") + 7
ReDim myarr(1 To 1, 1 To sonsat)
For i = 1 To sonsat
    deg = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[" & _
    kapali_dosya & "]" & sayfa & "'!R" & i & "C2")
    If CStr(Target.Value) = CStr(Right(deg, 10)) Then
        tar = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[" & _
        kapali_dosya & "]" & sayfa & "'!R" & i & "C3")
        sat = sat + 1
        myarr(1, sat) = Format(tar, "dd.mm.yyyy")
        var = True
    End If
Next i
If var = False Then
    MsgBox "Aranılan bulunamadı", vbCritical, "EVREN"
    Else
    ReDim Preserve myarr(1 To 1, 1 To sat)
    UserForm1.ListBox1.Column = myarr
    UserForm1.Label1.Caption = "Listelenen : " & Format(sat, "#,##0")
    UserForm1.Show
End If
End Sub
 

Ekli dosyalar

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
ilk baştan 7 satır boş olduğundan önceki yolladığım dosyada sondan 7 satırı sorgulayamayacaktı.Sonradan farkettim.
Dosyayı gücelledim tekrardan ayni yerden indirebilirsiniz.
Veya ilgili satır aşağıdaki ile değiştiriniz.:cool:
Kod:
sonsat = Application.ExecuteExcel4Macro("CountA('" & ThisWorkbook.Path & "\[" & _
kapali_dosya & "]" & sayfa & "'!C2)") [B][COLOR="Red"][SIZE="4"]+ 7[/SIZE][/COLOR][/B]
 
Katılım
17 Ocak 2008
Mesajlar
183
Excel Vers. ve Dili
2003
Merhaba evren hocam yukarıdaki kod normalde çalışıyor ancak beklenmedik bir durumla karşılaştım hücreye rakam yerine harf bile girilse arama yapıp aranılan bulunamadı uyarısı çıkıyor.istesiğim tabi mümkünse aramayı sayfanın F , I , M sütununda yapması bunun dışında arama yapmaması .Her şey için çok teşekkür ederim
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Kod:
if not isnumeric(target.value) then exit sub
Yukarıdaki satırı aşağıdaki satırın altına koyarsanız sayı girilmediği zaman arama yapmaz.
Ayrıca sanırım Şu anda kodlar sadece B sütununda arama yapıyor.:cool:
Kod:
If Target.Value = Empty Then Exit Sub
 
Katılım
17 Ocak 2008
Mesajlar
183
Excel Vers. ve Dili
2003
hocam kodu dediğiniz gibi yazdım ancak hücreye harf olduğundada arama yapıyor Benim üstteki mesajımda belirtiğim sütunlar kapalı çalışma sayfasındaki sütunlar değil çalıştığım çalışma kitabındaki sütunlar Çalışma kitabında sayının haricindede bilgi girişi yapıldığından ilgisi olmayan bir kelime yazıldığında mesaj çıksın istemiyorum hocaam biliyorum bu konmuda sizi çok yordum ilginiz için çok teşekkür ederim Ayrıca bu iki çalışma kitabını farklı klasör yada sürücülerde olması durumunda bu kod işlevsiz oluyor bunun çözümü varmıdır
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
hocam kodu dediğiniz gibi yazdım ancak hücreye harf olduğundada arama yapıyor Benim üstteki mesajımda belirtiğim sütunlar kapalı çalışma sayfasındaki sütunlar değil çalıştığım çalışma kitabındaki sütunlar Çalışma kitabında sayının haricindede bilgi girişi yapıldığından ilgisi olmayan bir kelime yazıldığında mesaj çıksın istemiyorum hocaam biliyorum bu konmuda sizi çok yordum ilginiz için çok teşekkür ederim Ayrıca bu iki çalışma kitabını farklı klasör yada sürücülerde olması durumunda bu kod işlevsiz oluyor bunun çözümü varmıdır
Son söylediğiniz cümle hariç diğerlerinden bir şey anlamadım.
Benim verdiğim kod sayısal bir değer girilmediği zaman prosedürden çıkılıyordu.
 
Katılım
17 Ocak 2008
Mesajlar
183
Excel Vers. ve Dili
2003
Evren hocam her şey için teşekkür ederim. Yanlışlık bendeymiş özür dilerim. Son haliyle tam istediğim gibi oldu. Emeğinize sağlık.
 
Katılım
5 Mayıs 2011
Mesajlar
4
Excel Vers. ve Dili
Excel2010
Word içerisindeki Excel eklentilerinde arama

Merhaba;
bir klasör içerisinde 1000'den fazla word dosyası ve bu word dosyalarında da eklenti halinde excel tabloları mevcut. Klasörün dışından bu tablolarda geçen kelimeleri aramak ve bulunanların hangi dosyada olduğunu görmek istiyorum. Bu mümkün müdür?
 
Üst