• DİKKAT

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

Aynı Ünvanlı Kişileri Başka Sayfaya Getirme

Katılım
26 Mart 2012
Mesajlar
253
Excel Vers. ve Dili
MİCROSOFT EXCELL OFFİCE 2007
Merhaba. Benim bir sorum olacak arkadaşlar. Nasıl yaparım diye düşündüm ama bulamadım bir türlü. yardımcı olursanız sevinirim.

sayfa 1 de 200 kişilik bir bordro var. Bu kişiler a dan z ye harf sırasına göre dizilmişler. ünvanları da karışık dizilmiş tabi. Ben bu bordroda ki aynı ünvanlı kişileri sayfa 2 de bir hücreye mesela temizlik personeli ünvanı girdiğim zaman aynı ünvanlı kişileri getirmesini istiyorum. bu mümkün mü acaba.
yardımlarınız için şimdiden teşekkürler.

Bir de sayfa 2 de bir formül var. formulün açılımı sayfa 1 deki hücre ile sayfa 2 deki hücreyi topluyor. yeni sayfa açtığımda bu formulü yeni sayfaya kopyaladığımda artık sayfa 1 deki değeri değil sayfa 2 deki değerle yeni açtığım sayfadaki değeri toplamasını istiyorum. yani verileri hep bir önceki sayfadan alsın istiyorum formülü kopyaladığım zaman. tşk ler.
 
Zafer bey,

Örnek bir dosya gönderir misiniz?

Hak verirsiniz ki, bu şekilde anlamak oldukça güç.

Kolay gelsin.
 
Arkadaşlar dosyayı ekledim. Aciil yardım lütfen
 

Ekli dosyalar

Arkadaşlar dosyayı ekledim. Aciil yardım lütfen

Merhaba
Boş bir module kopyalayın ve deneyin.
Kod:
Option Explicit
Sub veriler_getir_1967()
'Konu       :   Yazılan'a Göre Veri Getir
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Coder By   :   asi_kral_1967
Dim asi As Worksheet, kral As Range, ayyıldız As Variant
Dim Can_Mehmedim As Long, a As Variant
Application.ScreenUpdating = False
Range("A5:X" & Rows.Count).ClearContents
Set asi = Sheets("Sayfa1")
Can_Mehmedim = 5
a = ActiveCell.Address
Set kral = asi.Range("A:A").Find(Range("A4"), , , xlWhole)
ayyıldız = kral.Address
Do
asi.Range("A" & kral.Row & ":X" & kral.Row).Copy
Range("A" & Can_Mehmedim).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Can_Mehmedim = Can_Mehmedim + 1
Set kral = asi.Range("A:A").FindNext(kral)
Loop While Not kral Is Nothing And kral.Address <> ayyıldız
Range(a).Select
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı", vbInformation, "asi_kral_1967"
End Sub
Dosyanız Ekte.
 

Ekli dosyalar

Son düzenleme:
üstad olmadı kopyaladım sizin gönderdiğiniz dosyada da formül yok. Ilginiz için tşk ederim
 
hayır formülle değil sizin dediğiniz gibi yaptım ama olmadı tekrar yardımcı olabilirseniz sevinirim
 
üstat çok tşk ederim. A.r.o. Veri getir butonunu aynı sayfada başka hücreye de koyabiliyormuyuz.

Bir de ikinci sorumu cevaplandırabilirseniz çok sevinirim

muhabbetle...
 
üstat çok tşk ederim. A.r.o. Veri getir butonunu aynı sayfada başka hücreye de koyabiliyormuyuz.

Bir de ikinci sorumu cevaplandırabilirseniz çok sevinirim

muhabbetle...

Merhaba
Butonu istediğiniz yere çekebilirsiniz_?
İsterseniz A4 hücresindeki değişikliğe göre çalıştırabilirsiniz_?
Dilerseniz seçeceğiniz bir hücreye bağlı çalıştırabilirsiniz_?
Bir hücreye çift tıklama ile çalıştırabilirsiniz_?
Koda kısa yol atayıp o şekilde kullanabilirsiniz_?
Sayfa açıldığında kodu çalıştırabilirsiniz_?
Sayfadan çıkışta kodu çalıştırabilirsiniz_?
Formül yazarsınız formül hesap yaptığında kullanabilirsiniz_?
Dosyanıza link ekleyip buna tıkladığınızda çalıştıabilirsiniz_?
Özet Tablo var ise bunda değişiklik yaptığınızda çalıştırabilirsiniz_?
Kısa çok yöntemi var kodu kullanmanın size en uygun hangisi ise belirtin ona göre düzenleme yapmaya çalışalım.
 
Aynı sayfada veya farklı sayfada farklı bir hücreye gelip ünvanı yazdığım zaman hücrenin altına tüm verileri getirsin. bu şekilde olabilir mi acaba.

-----(SORU) Bir de sayfa 2 de bir formül var. formulün açılımı sayfa 1 deki hücre ile sayfa 2 deki hücreyi topluyor. yeni sayfa açtığımda bu formulü yeni sayfaya kopyaladığımda artık sayfa 1 deki değeri değil sayfa 2 deki değerle yeni açtığım sayfadaki değeri toplamasını istiyorum. yani verileri hep bir önceki sayfadan alsın istiyorum formülü kopyaladığım zaman. tşk ler.
 
Anlayamadım.
Lütfen dosya üzerinde açıklar mısınız_?
 
örnek dosya ektedir. Tşk ederim.

Sayfa2'de istediğiniz için olumsuz yanıt vermek zorundayım. Çünkü kod verileri getirdiğinde kodu tekrardan tetikleyecek ve sonsuz bir döngü içine girecek. Bunun yerine sabit bir satır seçin oradan işlemi yapalım.

Kopyalayarak formülleri değiştirme gibi bir şansımız yok ( benim bildiğim kadarı ile ) Ama hücreden bilgileri alarak yapabiliriz. Mesela 1 Hücreye Sayfa1 yazarsınız o sayfadaki istediğiniz hücredeki bilgiyi alırız.
 
Alternatif örnek;

Sayfa2'ye bir ComboBox ilave edip, kodları gerekli yerlere yapıştırdıktan sonra dosyayı tekrar açın ve ComboBox'tan Ünvan seçimi yapın..

ThisWorkbook kod sayfasına;
Kod:
[SIZE="2"]Private Sub Workbook_Open()
Call baglan
End Sub[/SIZE]
Module içerisine;
Kod:
[SIZE="2"]Public con As Object
Sub baglan()
    Set con = CreateObject("adodb.connection")
    con.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.FullName & _
    ";extended properties=""excel 8.0;hdr=yes"""
    Sayfa2.ComboBox1.Column = con.Execute("select distinct ÜNVANI from [Sayfa1$]").getrows
End Sub[/SIZE]

Sayfa2'nin kod sayfasına;
Kod:
[SIZE="2"]Private Sub ComboBox1_Change()
    Call baglan
    Dim rs As Object: Dim dosya As String: Dim sorgu As String

    Set rs = CreateObject("adodb.recordset")
    sorgu = "Select * From [Sayfa1$] where ÜNVANI ='" & ComboBox1.Text & "'"
    rs.Open sorgu, con, 1, 1
    
    Application.ScreenUpdating = False
    Cells.ClearContents
    
    For i = 0 To rs.fields.Count - 1
    Cells(4, i + 1) = rs.fields(i).Name
    Next i
    
    Range("A5").CopyFromRecordset rs
    Columns.AutoFit
    Application.ScreenUpdating = True
    
    dosya = "": sorgu = ""
    Set rs = Nothing: Set con = Nothing
End Sub[/SIZE]

Örnek dosyayı da ekliyorum...
 

Ekli dosyalar

Geri
Üst