• DİKKAT

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

Firma Değerlendirme Dosyası

  • Konbuyu başlatan Konbuyu başlatan cokcu
  • Başlangıç tarihi Başlangıç tarihi
Katılım
30 Nisan 2008
Mesajlar
10
Excel Vers. ve Dili
excel türkçe
Arkadaşlar Merhaba, Firma Değerlendirme dosyası adında bir dosya hazırlıyorum. İlk başta hazırladığım dosyada değerlendirme kriteri olarak 30 ürün için ayrı ayrı sayfalar oluşturup bir takım makro ve formüller ile dosyayı tamamlamıştım. Ancak Ürün sayısı 30 olduğu için hazırladığım dosyayı kullanmakta zorluk çektim. 10-12 Mb ı aştığı için kullanım sırasında yavaş çalışan bir dosya haline geldi. Bu yüzden bütün ürün sayfalarını silerek sadece 1 Pilot sayfa bıraktım. Bu Pilot sayfadaki ürün isimini değiştirince ilgili firma isimleri de formül yardımı ile farklı bir sayfadan veri alarak değişiyor. Değerlendirme işlemleri bitince Pilot sayfayı makro ile kopyalıyorum (sadece biçim ve değerleri, sayfa ismi otomatik olarak Seçili olan ürün ismini alıyor). Böylece dosya 3-4 mb ye kadar indi ve hızlı çalışıyor. Bu seferde her bir ürün için uygun firmaları tek sayfada göremiyorum.

Benim amacım bir buton yardımı ile Pilot sayfada seçili olan ürün adını Değerlendirme sayfasında Yatay olarak arayıp bulduğu hücrenin altına Pilot sayfadaki Uygun olan firmalar listesini kopyalamak(sadece değerleri) *formülleri değil...*

Bazı araştırmalar yaptım ancak uygun olanı bulamadım, şablon olarak bir dosya ekledim. Yardımcı olursanız sevinirim.
 

Ekli dosyalar

Sayın Cokcu,

Pliot Sayfasına Aşağıdaki kodu uygulayınız.

Kodları hazırlarken alıntılar yaptığım Sayın Korhan Ayhan ve Sayın Zafer Hocam'a çok teşekürler.

Kod:
Sub AKTAR()
Dim sut As Integer
Set s1 = Sheets("Pilot")
Set s2 = Sheets("Değerlendirme")
sut = ActiveCell.Column
'sut = 1
If s1.Range("B1") = "" Then
MsgBox "Lütfen Ürün Şeçiniz!", vbExclamation
Exit Sub
End If
For sut = 1 To 30
For i = 11 To 25

If s1.Range("B1") = s2.Cells(2, sut) Then
s2.Cells(i - 8, sut).Value = s1.Cells(i, 1).Value

End If
Next
Next
MsgBox "Aktarma İşleminiz tamamlanmıştır.", vbInformation
End Sub

Pilot sayfasındaki form düğmesine yukarıdaki kodları atayınız. B1 hücresinden ürün şeçtikten sonra A11:A25 arasındaki uygun değerler Değerlendirme sayfasındaki ilgili ürünün altına sıralanacaktır.
 
Son düzenleme:
Ergün Bey, ilginiz için teşekkür ederim. Takıldığım bu noktayı çözdünüz.
 
Rica ederim. Çözüm bulmanıza sevindim.

Kodları hazırlarken alıntılar yaptığım Sayın Korhan Ayhan ve Sayın Zafer Hocam'a çok teşekürler.
 
Geri
Üst