• DİKKAT

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

ComboBox

Katılım
13 Mayıs 2011
Mesajlar
23
Excel Vers. ve Dili
2007
Merhabalar. Birkaç gündür internette taramadığım yer kalmadı ama bir türlü istediğim şeyi bulamadım. Yardımcı olacak arkadaşlara şimdiden çok teşekkür ederim. yapmak istediğim şey, bir excel kitabında sayfa2'deki bir tabloyu ( ya da bir hücre grubunu demek daha mı doğru olur) açılır menü yardımıyla sayfa1'e almak istiyorum. Açılır menüden seçim yaparak belli hücre aralığını sayfa bire alabilrmiyim..
 

Ekli dosyalar

Merhabalar. Birkaç gündür internette taramadığım yer kalmadı ama bir türlü istediğim şeyi bulamadım. Yardımcı olacak arkadaşlara şimdiden çok teşekkür ederim. yapmak istediğim şey, bir excel kitabında sayfa2'deki bir tabloyu ( ya da bir hücre grubunu demek daha mı doğru olur) açılır menü yardımıyla sayfa1'e almak istiyorum. Açılır menüden seçim yaparak belli hücre aralığını sayfa bire alabilrmiyim..

Selam,
dosyanızı 2003 (*.xls) formatında yollabilirseniz. Daha iyi yardım alabilirsiniz.
İyi çalışmalar.
 
Merhabalar. Birkaç gündür internette taramadığım yer kalmadı ama bir türlü istediğim şeyi bulamadım. Yardımcı olacak arkadaşlara şimdiden çok teşekkür ederim. yapmak istediğim şey, bir excel kitabında sayfa2'deki bir tabloyu ( ya da bir hücre grubunu demek daha mı doğru olur) açılır menü yardımıyla sayfa1'e almak istiyorum. Açılır menüden seçim yaparak belli hücre aralığını sayfa bire alabilrmiyim..

merhaba
eki inceleyiniz
 

Ekli dosyalar

İhsan bey allah razı olsun bir haftadır nasıl olcak diye kıvrandım durdum. Bunun nasıl yapıldığından biraz bahsedebilirmisiniz..bir de aynı şekilde bir MS project Dosyasını excel de açabilir miyiz? yardımlarınız için çok teşekkür ederim.
 
Merhaba,

Yanıt : 2

Aşağıdaki kod ThisWorkbook'un kod sayfasında olmalı. Dosya açıldığında combobox oluşmalı.

Kod:
Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Sheets("Sayfa2").Select
    Sheets("Sayfa1").Select
    Application.ScreenUpdating = True
    
End Sub

Aşağıdaki kodlar ise Sayfa1'in Kod Sayfasında olmalı.

Kod:
Private Sub ComboBox1_Change()
    Dim c   As Range, _
        s2  As Worksheet
    
    Set s2 = Sheets("Sayfa2")
    Set c = s2.Range("A:A").Find(ComboBox1.Value, LookIn:=xlValues)
    If c Is Nothing Then Exit Sub
    Range("A10").CurrentRegion.Delete
    s2.Range(c.Address).CurrentRegion.Copy [A10]
End Sub

Kod:
Private Sub Worksheet_Activate()
    Dim i   As Long
    Dim s2  As Worksheet
    
    Set s2 = Sheets("Sayfa2")
    ComboBox1.Clear
    
    For i = 2 To s2.Cells(Rows.Count, "A").End(3).Row
        If Not s2.Cells(i, "A") = "" Then ComboBox1.AddItem s2.Cells(i, "A")
    Next i
End Sub

Sayfa2 deki bilgilerin yapısı da şöyle olmalı :

Herbir grubun arasında mutlaka en az 1 satır boş olmalı.

A sütunundaki başlığı birleştirebilirsiniz ama gruplar arasında verdiğiniz boş satırı kapsamamalı.

Durum böyle olunca istediğiniz kadar grup oluşturabilirsiniz.
 

Ekli dosyalar

Ya arkadaşlar çok afedersiniz, ben bu program işlerindn pek anlamadığımdan işin içinden çıkamadım daha önce göndermiş olduğum excel dosyasında, proje planı ve ürün özellikleri A sütununda idi şimdi isa başlık kısmını yataya aldım ve hücreleri birleştirdim,ancak combox da nasıl yapabileceğimi bulamadım, Yarına kadar bu işi çözmem lazım yardımcı olursanız çok mutlu olurum, ek de excel dosyasını ekledim.. şimdiden çok teşekkür ederim
 

Ekli dosyalar

Kafanıza göre format değiştirirseniz kodların çalışmaması doğal.
 
Yardım etmeyiz mi dedik? :)

Ama bir önceki mesajımda verdiğim otomatik durum şimdi kalktı.

Sayfa1 de N sütununu aracı sütun olarak kullandım. Üşendim uzun uzun kod yazmaya, ilk mesajımda olduğu gibi, işi kısa tuttum.

Aşağıdaki kodlar Sayfa1 in kod bölümünde olmalı.

Kod:
Private Sub ComboBox1_Change()
    Dim c   As Range, _
        i   As Long, _
        s2  As Worksheet
    On Error Resume Next
    Set s2 = Sheets("Sayfa2")
    Set c = s2.Cells.Find(ComboBox1.Value, LookIn:=xlValues)
    If c Is Nothing Then Exit Sub
    i = Cells(Rows.Count, "B").End(3).Row
    If i < 10 Then
        i = 10
    Else
        i = i + 10
    End If
    Application.EnableEvents = False
    If Not Range("B10") = "" Then Rows("10:" & i).Delete Shift:=xlUp
    s2.Range(c.Address).CurrentRegion.Copy [b10]
    Application.EnableEvents = True
End Sub
 

Ekli dosyalar

hocam süpersiniz :D ellerine emeklerinize sağlık.. çok çok teşekkür ederim,
 
necdet hocam'a alternatif olmaz ama
Kod:
Private Sub ComboBox1_Change()
If ComboBox1 = "Proje Planı" Then
Range("A10:E20").ClearContents
Range("A10") = Sheets("Sayfa2").Range("E7").Text
Range("A11") = Sheets("Sayfa2").Range("E8").Text
Range("B11") = Sheets("Sayfa2").Range("F8").Text
Range("C11") = Sheets("Sayfa2").Range("G8").Text
Range("D11") = Sheets("Sayfa2").Range("H8").Text
Range("E11") = Sheets("Sayfa2").Range("I8").Text
Range("E12") = Sheets("Sayfa2").Range("I9").Text
Range("A12") = Sheets("Sayfa2").Range("E9").Text
Range("B12") = Sheets("Sayfa2").Range("F9").Text
Range("C12") = Sheets("Sayfa2").Range("G9").Text
Range("D12") = Sheets("Sayfa2").Range("H9").Text
Range("E12") = Sheets("Sayfa2").Range("I9").Text
Range("A13") = Sheets("Sayfa2").Range("E10").Text
Range("B13") = Sheets("Sayfa2").Range("F10").Text
Range("C13") = Sheets("Sayfa2").Range("G10").Text
Range("D13") = Sheets("Sayfa2").Range("H10").Text
Range("E13") = Sheets("Sayfa2").Range("I10").Text
Range("A14") = Sheets("Sayfa2").Range("E11").Text
Range("B14") = Sheets("Sayfa2").Range("F11").Text
Range("C14") = Sheets("Sayfa2").Range("G11").Text
Range("D14") = Sheets("Sayfa2").Range("H11").Text
Range("E14") = Sheets("Sayfa2").Range("I11").Text
Range("A15") = Sheets("Sayfa2").Range("E12").Text
Range("B15") = Sheets("Sayfa2").Range("F12").Text
Range("C15") = Sheets("Sayfa2").Range("G12").Text
Range("D15") = Sheets("Sayfa2").Range("H12").Text
Range("E15") = Sheets("Sayfa2").Range("I12").Text
ElseIf ComboBox1 = "Ürün Özellikleri" Then
Range("A10:E20").ClearContents
Range("A10") = Sheets("Sayfa2").Range("E14").Text
Range("B11") = Sheets("Sayfa2").Range("F15").Text
Range("C11") = Sheets("Sayfa2").Range("G15").Text
Range("D11") = Sheets("Sayfa2").Range("H15").Text
Range("B12") = Sheets("Sayfa2").Range("F16").Text
Range("C12") = Sheets("Sayfa2").Range("G16").Text
Range("D12") = Sheets("Sayfa2").Range("H16").Text
Range("B13") = Sheets("Sayfa2").Range("F17").Text
Range("C13") = Sheets("Sayfa2").Range("G17").Text
Range("D13") = Sheets("Sayfa2").Range("H17").Text
Range("B14") = Sheets("Sayfa2").Range("F18").Text
Range("C14") = Sheets("Sayfa2").Range("G18").Text
Range("D14") = Sheets("Sayfa2").Range("H18").Text
Range("B15") = Sheets("Sayfa2").Range("F19").Text
Range("C15") = Sheets("Sayfa2").Range("G19").Text
Range("D15") = Sheets("Sayfa2").Range("H19").Text
Range("B16") = Sheets("Sayfa2").Range("F20").Text
Range("C16") = Sheets("Sayfa2").Range("G20").Text
Range("D16") = Sheets("Sayfa2").Range("H20").Text
End If
End Sub
bu kod işinizi görebilir
 
Peki bir Soru daha ComboBoxla Ms project nasıl açarım, yani istiyorum combobox açıldığında plan, ve ürün özelliklerine tıkladığımda sayfa 2 den tablolardan veri alsın(tamam bunu çözdük diyebilir
z) ama asıl yapmak isteediğiim, Ms project tıkladığımda bir MS project dosyası açsın. şimdiden teşekkürler
 
Son düzenleme:
Geri
Üst