• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Otomatik Köprü Atama.

C

constantinepolisi

Katılım
31 Ocak 2013
Mesajlar
55
Excel Vers. ve Dili
2010 Türkçe
Merhabalar,
Örnek dosya da O sütuna otomatik köprü atamak istiyorum.
Çıkışlar sayfasına yazılan TARİH ve TİP KODU, GÖNDERİLENLER sayfasıyla uyuşuyorsa, O sütunda Gönderilen sayfasında ki verileri seçecek köprü bağlantısı olsun istiyorum. Bu işlemi otomatik yapılandırabilir miyiz? Ya da ne kadar yapılandırılabilir. Formül, makro, ad tanımlama, koşul vs. farklı yöntemler. Hiç fark etmez örnek teki gibi bir şeyler olsun yeterlidir.
Örnek dosyadan Çıkışlar sayfasını 3 satırını inceleyip, O3 hücresini tıkladığınızda daha net anlaya bileceğinizi umuyorum.

http://www.dosya.tc/server2/iEiIOc/_rnek.rar.html

Yardımcı olabilecek herkese teşekkür ediyorum.
İyi çalışmalar dilerim.
 
Son düzenleme:
Merhaba,

Örnek çalışmanızı farklı bir sitede eklediğiniz dosya üzerinden paylaşmanızdaki mantığı anlayamadım.

Sorunuzu burada örnek bir dosya ekleyerek açıklarmısınız.
 
O3:

Kod: 
=KÖPRÜ("[[COLOR=red]Örnek[/COLOR].[COLOR=blue]xls[/COLOR]]'GÖNDERİLENLER'!A"&KAÇINCI(A3&C3;GÖNDERİLENLER!$F$3
 :$F$50&GÖNDERİLENLER!$A$3:$A$50;0)+2&":F"&TOPLA(EĞER(GÖNDERİLENLER!$F$3
  :$F$50&GÖNDERİLENLER!$A$3:$A$50=A3&C3;1))+KAÇINCI(A3&C3;GÖNDERİLENLER!$F$3
   :$F$50&GÖNDERİLENLER!$A$3:$A$50;0)+1;"Listeyi Bul")

Dizi formülüdür. Girişini ctrl shift enter tuş kombinasyonu ile yapınız.

.
 
Merhaba Ömer Bey,
Rica etsem örnek Çalışmaya uygulaya bilir misiniz. Ben yaptım sonuç alamadım. Tıklıyorum olmuyor. CTRL+SHIFT+ENTER denedim olumsuz :(
 
Son düzenleme:
Dosya ektedir.
Ben fonksiyonla yaptım dilerseniz makroyla da yapılabilir.

.
 

Ekli dosyalar

Merhaba Ömer Bey,
Bir örnek ekleme yaptım gönderilenler sayfasına baktığınızda bir açıklama ekledim. Bir sorun veriyor. Buna bir çözüm olabilir mi. Bu arada tam istediğim gibi olmuş. Elinize sağlık. Bu arada bir sorun daha var, bu makroda olabilir mi gönderilenler sayfası veri yüklenmesinden nerdeyse 65536 son hücreye kadar gidebilir. Dosya ağırlaşacaktır.
İlginiz için çok teşekkür ediyorum. Böyle bir şey mümkün değildir dedim kendi kendime :)
Şükür çözüm yolu varmış.

http://www.dosya.tc/server2/itwDGc/_rnek.rar.html
 
Makro ile yapılabilir.

Diğer konuyu doğru anladıysam, "GÖNDERİLENLER" sayfası C sütununda birleştirilmiş hücre kullandığınızdan dolayı seçimi tümüyle yapmaktadır. Bunu engellemek için ya birleştirilmiş hücre kullanmayacaksanız yada örneğin, a:f sütun aralığını değil de a:b sütun aralığına denk gelen bölümü seçebiliriz.

Bu kısımları netleştirdikten sonra gereken makro kodunu yazarım.
 
Merhaba Ömer Bey, İyi aksamlar.
Evet, Ömer Bey konuyu doğru anladığınızı ve bu yüzden birden çözüme bu kadar çabuk yaklaştığımızı düşünüyorum. Maksat gönderilenler sayfasından herhangi bir alanı seçmek değil, çıkışa ait veriyi seçmek. A ile B sütunu seçimlemiş olursak, o tarihte çıkan tüm bilgileri seçimlemiş oluruz. Ben günde yüzlerce veri gönderimi yapıyorum. Ama o tarihte o tip demiş olursak doğrudan sonuca gitmiş oluruz. Bu yüzden şartlı bir çözüm getirilmesi gerekiyor. Yoksa verdiğiniz örnek çok güzel, çalışma için çok uygun, bunu da bir çözüm getirmemiz gerekiyor. Birde makroda deneye bilir miyiz?
Tekrardan teşekkür eder, iyi akşamlar dilerim.
Syg.
 
Merhaba,

Aşağıdaki kodlardan dilediğinizi kullanabilirsiniz.

"O" sütunundaki hücreyi seçerek alana ulaşmak için aşağıdaki kodu kullanabilirsiniz.

Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Bul As Range, S2 As Worksheet, Adres As String, Alan As Range
    
    If Intersect(Target, Range("O3:O" & Rows.Count)) Is Nothing Then Exit Sub
    If Cells(Target.Row, "A") <> "" And Cells(Target.Row, "C") <> "" Then
        Set S2 = Sheets("GÖNDERİLENLER")
        Set Bul = S2.Range("A:A").Find(Cells(Target.Row, "C"), , , xlWhole)
        If Not Bul Is Nothing Then
            Adres = Bul.Address
            Do
                If Bul.Offset(0, 5) = Cells(Target.Row, "A") Then
                    If Alan Is Nothing Then
                        Set Alan = Union(Bul, Bul.Offset(0, 1))
                    Else
                        Set Alan = Union(Alan, Bul, Bul.Offset(0, 1))
                    End If
                End If
                Set Bul = S2.Range("A:A").FindNext(Bul)
            Loop While Not Bul Is Nothing And Bul.Address <> Adres
        End If
        
        If Not Alan Is Nothing Then
            S2.Select
            Alan.Select
        End If
    End If
End Sub


"O" sütunundaki hücreye çift tıklayarak alana ulaşmak için aşağıdaki kodu kullanabilirsiniz.

Kod: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim Bul As Range, S2 As Worksheet, Adres As String, Alan As Range
    
    If Intersect(Target, Range("O3:O" & Rows.Count)) Is Nothing Then Exit Sub
    If Cells(Target.Row, "A") <> "" And Cells(Target.Row, "C") <> "" Then
        Cancel = True
        Set S2 = Sheets("GÖNDERİLENLER")
        Set Bul = S2.Range("A:A").Find(Cells(Target.Row, "C"), , , xlWhole)
        If Not Bul Is Nothing Then
            Adres = Bul.Address
            Do
                If Bul.Offset(0, 5) = Cells(Target.Row, "A") Then
                    If Alan Is Nothing Then
                        Set Alan = Union(Bul, Bul.Offset(0, 1))
                    Else
                        Set Alan = Union(Alan, Bul, Bul.Offset(0, 1))
                    End If
                End If
                Set Bul = S2.Range("A:A").FindNext(Bul)
            Loop While Not Bul Is Nothing And Bul.Address <> Adres
        End If
        
        If Not Alan Is Nothing Then
            S2.Select
            Alan.Select
        End If
    End If
End Sub
 
Merhaba Korhan Bey,

Benim için ilk kod daha uygun ama onunda değişilmesi gereken iki minik sorun var.
Tip kodu ve Tarih gönderilen ile uygun ise, O sütunda LİSTEYİ GÖSTER yazısı gelmeli. Tıklandığında ise A ve B deki veriler değil Çıkışa uygun A ve F olarak seçilmeli. Linkteki örnek dosya da Listeye git uyarısı otomatik geliyor, fakat butonla çalışıyor. Butonsuz olmalı. Diğer bir sorun ise, hedefteki liste alanı seçmiyor. Bu kodların birilerini istenilen gibi uyarlarsak çok daha iyi olacaktır.
Çok teşekkür ediyorum konuya yardımlarınızdan ötürü çok sağ olun.
İyi çalışmalar dilerim.
LİNK
Kod: 
http://www.dosya.tc/server2/oazP10/_rnek.rar.html
 
Aşağıdaki kodları deneyiniz.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bul As Range, S2 As Worksheet, Adres As String
    
    If Intersect(Target, Range("A3:A" & Rows.Count, "C3:C" & Rows.Count)) Is Nothing Then Exit Sub
    Cells(Target.Row, "O").Clear
    If Cells(Target.Row, "A") <> "" And Cells(Target.Row, "C") <> "" Then
        Set S2 = Sheets("GÖNDERİLENLER")
        Set Bul = S2.Range("A:A").Find(Cells(Target.Row, "C"), , , xlWhole)
        If Not Bul Is Nothing Then
            Adres = Bul.Address
            Do
                If Bul.Offset(0, 5) = Cells(Target.Row, "A") Then
                    With Cells(Target.Row, "O")
                        .Value = "LİSTEYİ GÖSTER"
                        .Font.Bold = True
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlCenter
                        .Font.ColorIndex = 3
                        .Font.Underline = xlUnderlineStyleSingle
                    End With
                    Exit Do
                End If
                Set Bul = S2.Range("A:A").FindNext(Bul)
            Loop While Not Bul Is Nothing And Bul.Address <> Adres
        End If
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Bul As Range, S2 As Worksheet, Adres As String, Alan As Range
    
    If Intersect(Target, Range("O3.O" & Rows.Count)) Is Nothing Then Exit Sub
    If Cells(Target.Row, "A") <> "" And Cells(Target.Row, "C") <> "" Then
        Set S2 = Sheets("GÖNDERİLENLER")
        Set Bul = S2.Range("A:A").Find(Cells(Target.Row, "C"), , , xlWhole)
        If Not Bul Is Nothing Then
            Adres = Bul.Address
            Do
                If Bul.Offset(0, 5) = Cells(Target.Row, "A") Then
                    If Alan Is Nothing Then
                        Set Alan = Bul
                    Else
                        Set Alan = Union(Alan, Bul)
                    End If
                End If
                Set Bul = S2.Range("A:A").FindNext(Bul)
            Loop While Not Bul Is Nothing And Bul.Address <> Adres
        End If
        
        If Not Alan Is Nothing Then
            S2.Select
            Alan.Resize(Alan.Rows.Count, 6).Select
        End If
    End If
End Sub
 
Merhaba Korhan Bey,
Çok teşekkür ediyorum güzel olmuş elinize bilginize sağlık, hedef seçilirken A ve F seçiliyor, A3:F10 aralığı seçilmiyor. Bu şekilse seçilmesi sağlana bilir mi. Buradan farklı işlem yapacağım. O nedenle bu kadar ısrar ediyorum.
Tekrardan teşekkür ediyorum. Elinize sağlık. İyi çalışmalar dilerim.
 
Korhan Bey,
Vaktiniz olduğunda konuya yeniden göz atabilir misiniz? Küçük bir sıkıntımız var onu da hallederseniz çok sevinirim.

İyi çalışmalar dilerim.
 
Merhaba,

Ben denediğimde "A3:A10" ve "F3:F10" aralığı seçiliyor. Bir yanlışlık olmasın...
 
Merhaba Korhan Bey,
Sanırım anlaşmazlık oluyor, tekrar denedim yine aynı sorun oldu. Örnek dosyayı inceler misiniz? Listeyi göster tıklandığında, A sütunu ve F sütunu seçiliyor sadece, aradaki sütunlar seçilmiyor yani A3:F10 Ekteki dosyayı kontrol etmenizi rica ediyorum.
 

Ekli dosyalar

Merhaba Korhan Bey,
Vaktiniz olduğunda yeniden göz atarsanız sevinirim. Sorun eğer benim dediğim gibi size göre çözümleniyorsa, bir yerlerde kesin hata yapıyorumdur. Beni aydınlatırsanız kodu kullanmaya başlayacağım.
İyi akşamlar dilerim :cool:
 
Merhaba,

Daha önceki mesajlarınızda yazdığınız açıklamalardan dolayı seçimi bu şekilde istediğinizi düşünmüştüm.

Üstteki mesajımda ki kodu güncelledim. Deneyiniz.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst