• DİKKAT

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

DÜŞEYARA Yerine iF ile Sayfalardan veri çek

O

ozkovlu

Katılım
22 Ekim 2011
Mesajlar
261
Excel Vers. ve Dili
2013
Merhabalar;
Düşeyara fonksiyonu ile yaptığımız işlemi makro ile nasıl yapabiliriz.
Ekte göndermiş olduğum dosyada, 5 adet sayfa var.
1-AnaSayfa=Verilerin çekileceği sayfa
2-Memur=Memur personellerin bilgilerinin saklandığı sayfa
3-Sözlesmeli=Sözleşmeli personelin bilgilerinin saklandığı sayfa
4-İsci=İşçi personellerin bilgilerinin saklandığı sayfa
5-Taseron=Taşeron personellerin bilgilerinin saklandığı sayfa.
Bu bilgiler ışığında; AnaSayfada Seçenek düğmelerinde hangi Personel Tipi seçilmiş ise, ona göre "C3" hücresine personel isimlerinin gelmesi ve personel seçildiğinde onunla alakalı bilgilerinin ilgili hücrelere aktarılmasını sağlamak.
Saygılarımla...

http://s6.dosya.tc/server8/r43d9c/sayfa_sonu.zip.html
 
Açılır Liste kutusuna aşağıdaki kod yardımı ile verileri çektim. Sadece Seçilen personelle alakalı diğer bilgilerin getirilmesi kaldı.

Kod: 
MemurVeriAl()
'
' Acilrkutuyaverial Makro
'

    ActiveSheet.Shapes.Range(Array("Drop Down 13")).Select
    With Selection
        .ListFillRange = "Memur!$C$2:$C$16"
        .LinkedCell = "$C$4"
        .DropDownLines = 8
        .Display3DShading = True
    End With
    Range("c3").Select
   
End Sub
Sub SozlesmeliVeriAl()
'
' Acilrkutuyaverial Makro
'

    ActiveSheet.Shapes.Range(Array("Drop Down 13")).Select
    With Selection
        .ListFillRange = "Sözlesmeli!$C$2:$C$16"
        .LinkedCell = "$C$4"
        .DropDownLines = 8
        .Display3DShading = True
    End With
    Range("c3").Select
End Sub

Sub İsciVeriAl()
'
' Acilrkutuyaverial Makro
'
    ActiveSheet.Shapes.Range(Array("Drop Down 13")).Select
    With Selection
        .ListFillRange = "isci!$C$2:$C$16"
        .LinkedCell = "$C$4"
        .DropDownLines = 8
        .Display3DShading = True
    End With
    Range("c3").Select
End Sub
Sub TaseronVeriAl()
'
' Acilrkutuyaverial Makro
'
    ActiveSheet.Shapes.Range(Array("Drop Down 13")).Select
    With Selection
        .ListFillRange = "Taseron!$C$2:$C$16"
        .LinkedCell = "$C$4"
        .DropDownLines = 8
        .Display3DShading = True
    End With
    Range("c3").Select
End Sub
 
Son düzenleme:
Merhaba,
Örnek dosyanıza göre yazılan aşağıdaki kodu dener misiniz?
Kod: 
Dim SayfaAdı As String

Sub SeçenekDüğmesi5_Tıklat()
SayfaAdı = "Memur"
VeriDogrula
End Sub
Sub SeçenekDüğmesi6_Tıklat()
SayfaAdı = "Sözlesmeli"
VeriDogrula
End Sub
Sub SeçenekDüğmesi7_Tıklat()
SayfaAdı = "isci"
VeriDogrula
End Sub
Sub SeçenekDüğmesi9_Tıklat()
SayfaAdı = "Taseron"
VeriDogrula
End Sub

Sub VeriDogrula()
Sheets("AnaSayfa").Range("C3:C27").ClearContents
Sheets("AnaSayfa").Range("C3").Select
Sheets("AnaSayfa").Range("C3") = "Kişi Adı Seçiniz"
    With Range("C3").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=" & SayfaAdı & "!$C$2:$C$6"
    End With
End Sub

Sub Aktar()
Bulunacak = Sheets("AnaSayfa").Range("C3").Value
Set Aranan = Sheets(SayfaAdı).Range("C:C").Find(Bulunacak, , xlValues, xlWhole)

If Not Aranan Is Nothing Then
    Adres = Aranan.Address
    Do
    Sheets(SayfaAdı).Range("B" & Aranan.Row & ":V" & Aranan.Row).Copy
    Sheets("AnaSayfa").Range("C4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Set Aranan = Sheets(SayfaAdı).Range("C:C").FindNext(Aranan)
    Loop While Not Aranan Is Nothing And Aranan.Address <> Adres
End If
    Application.CutCopyMode = False
    Sheets("AnaSayfa").Range("C3").Select
MsgBox "Aktarma İşlemi Tamamlandı. ", vbInformation, "dEdE  " & _
Application.UserName & "'e Başarılar Diler."

End Sub
 
Arkadaşlar Merhaba,

İyi bir excel kullanıcısı değilim düşeyara ile ilk sütunda aranan bulunan değerin yanındaki hücreye getiren birşey yazdım ama arattığımız sütun sayısını 3 e çıkarmam gerekiyor. Nasıl yapabilirim yardımcı olursanız sevinirim.
 
DÜŞEYARA Yerine Makro kullan

Merhabalar dEdE;
Kod çalışman güzel olmuş fakat ben çalıştıramadım.

Düşearayı aşağıdaki kodlar yardımı ile çözdüm gibi,Fakat iyi çalışmıyor.
Kodların düzenlenmesi icap ediyor. Bilgisayarı çok kasıyor.

Sub DuseyAra()


If Range("b1").Value = "1" Then


[c5] = "=VLOOKUP(R3C3,TabloMemur,2,FALSE)"
[c6] = "=VLOOKUP(R3C3,TabloMemur,3,FALSE)"
[c7] = "=VLOOKUP(R3C3,TabloMemur,4,FALSE)"
[c8] = "=VLOOKUP(R3C3,TabloMemur,5,FALSE)"
[c9] = "=VLOOKUP(R3C3,TabloMemur,6,FALSE)"

ElseIf Range("b1").Value = "2" Then

[c5] = "=VLOOKUP(R3C3,TabloSozlesme,2,FALSE)"
[c6] = "=VLOOKUP(R3C3,TabloSozlesme,3,FALSE)"
[c7] = "=VLOOKUP(R3C3,TabloSozlesme,4,FALSE)"
[c8] = "=VLOOKUP(R3C3,TabloSozlesme,5,FALSE)"
[c9] = "=VLOOKUP(R3C3,TabloSozlesme,6,FALSE)"

ElseIf Range("b1").Value = "3" Then

[c5] = "=VLOOKUP(R3C3,Tabloisci,2,FALSE)"
[c6] = "=VLOOKUP(R3C3,Tabloisci,3,FALSE)"
[c7] = "=VLOOKUP(R3C3,Tabloisci,4,FALSE)"
[c8] = "=VLOOKUP(R3C3,Tabloisci,5,FALSE)"
[c9] = "=VLOOKUP(R3C3,Tabloisci,6,FALSE)"

ElseIf Range("b1").Value = "4" Then

[c5] = "=VLOOKUP(R3C3,TabloTaseron,2,FALSE)"
[c6] = "=VLOOKUP(R3C3,TabloTaseron,3,FALSE)"
[c7] = "=VLOOKUP(R3C3,TabloTaseron,4,FALSE)"
[c8] = "=VLOOKUP(R3C3,TabloTaseron,5,FALSE)"
[c9] = "=VLOOKUP(R3C3,TabloTaseron,6,FALSE)"


End If

End Sub
Genişletmek için tıkla ...

Çalışmanın son hali ektedir.
http://s3.dosya.tc/server10/1i5wrn/sayfa_sonu.zip.html
 
Son düzenleme:
Merhaba,
Kod örnek dosyanızda sorunsuz çalışıyor. Gerçek dosyanız bundan farklı ise bunu bilemem. Bir üst mesajda yazdığınız kodlar ilgili hücrelere formüller yazıyor. Formül yazılacaksa kod yazmanın anlamı yoktur. Çok sayıda formülün sürekli hesaplanması bilgisayarı kasar.
Üç no.lu mesajdaki kodları ilk mesajınıza eklediğiniz dosyada bir modüle yapıştırıp deneyiniz. Hatasız ve çok hızlı çalıştığını göreceksiniz.
Size uymayan durum nedir? Belirtirseniz çözmeye çalışırız.
Örneğin aslını tam olarak yansıtması gereksiz zaman ve emek kaybını önler.
Hoşça kalın.
 
dEdE Merhabalar;
Kodunuz on numara çalışıyor. Emeğinize sağlık.
İsimleri Veri doğrulamaya değil de, Açılır Liste Kutusuna nasıl aktarabiliriz.
 
Son düzenleme:
İsimleri Veri doğrulamaya değil de, Açılır Liste Kutusuna nasıl aktarabiliriz.
Genişletmek için tıkla ...
Kod: 
ActiveSheet.Shapes.Range(Array("Drop Down 13")).Select
    With Selection
        .ListFillRange = SayfaAdı & "!$C$2:$C$6"
        .LinkedCell = "$C$3"
        .DropDownLines = 8
        .Display3DShading = True
    End With
    
    Range("c2").Select
 
Aktar işleminde hata veriyor. Nasıl çözebiliriz.
Bulunacak = Sheets("AnaSayfa").Range("C3").Value
Set Aranan = Sheets(SayfaAdı).Range("C:C").Find(Bulunacak, , xlValues, xlWhole)
Genişletmek için tıkla ...
 
dEde MErhabalar;
Veri doğrulamaya Aktar makrosunu nasıl atayabiliriz.
 
Anasayfa da bulunan kaydet düğmesine sağ tıklayın açılan seçeneklerden Makro ata yı seçin. Açılacak pencerede sol tarafta makro adları görünecek oradan aktar ı seçip tamam deyin. Bu kadar.
 
dEde MErhabalar;
Aktar makrosunda ara sıra hata veriyor. Genellikle dosya ilk açıldığında oluyor.

hataa.PNG.html

http://s9.dosya.tc/server2/r375u4/hataa.PNG.html
 
ozkovlu' Alıntı:
...
Aktar makrosunda ara sıra hata veriyor. Genellikle dosya ilk açıldığında oluyor.
Genişletmek için tıkla ...

Merhabalar,
Dosya ilk açıldığında seçenek düğmelerinden birisine tıklamak gerekir. Sayfa adını belirlemek için bu gereklidir. Bu işlemi otomatik olarak yapabiliriz. Aşağıdaki kodu ThisWorkbook( Bu çalışma kitabı) kısmına ekleyiniz.
Kod: 
Private Sub Workbook_Open()
    SeçenekDüğmesi5_Tıklat
End Sub
 
ozkovlu' Alıntı:
...AnaSayfa 'ya koruma koyduğumda ekteki hatayı veriyor.
Aşağıdaki kodları kullandım fakat bi fayda vermedi.Bu işlemi nasıl düzeltebilirim.
Kod: 
ActiveSheet.Unprotect "123" 'Sayfa korumasız
ActiveSheet.Protect "123" 'Sayfa korumalı
Genişletmek için tıkla ...

Merhaba,
"Unprotect" komutunu hata veren satırdan önce yamayı deneyiniz.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst