Otomatik Metin Çağırma Yardım!

Katılım
7 Şubat 2008
Mesajlar
7
Excel Vers. ve Dili
MS Office 2003 TR
Merhaba arkadaşlar. Bu konuda belkide forumda daha evvel örnekler olabilir. Fakat yaklaşık 1 saattir arayıp denediklerimde malesef birşey yapamadım. Belkide benim cahilliğimdendir. Yardımcı olursanız çok sevinirim.



Bize lazım olan eklediğim resimde görülen 2 cockpit ve 4 adet kabin listesinin yuvarlak içine alıp A olarak belirttiğim alana örneğin A5 hücresine SS yazdığımda, hemen sağdaki alanlara ilgili koda sahip kaptanın ismi, telefonu, adresi gelsin istiyorum. Yani kod verip o koda ait olan isim, tlf, adres hücrelerinin otomatik gelmesini istiyorum.
Bu bilgileride 2. bir çalışma sayfasından almasını istiyorum. Yani veriyi Kokpit Listesinden almalı. Aynı şekilde kabinde kabin listesi diye açtığımız 3. bir sayfadan çağrılmalı.

Bahsettiğim çalışma kitabını ekliyorum. Anlatmaya çalıştığım işlevin sonucunuda elle 5. satıra yazıyorum. 5. satırdan sadece SS kısmını elle yazmak veya açılır bir listeden seçmek istiyorum.

Mümkünmüdür? Mümkünse yardımlarınızı bekliyorum. Şimdiden okuyup zaman ayıranlara ve yardımcı olmaya çalışanlara teşekkür ederim. Saygılarımla.
 

Ekli dosyalar

Katılım
7 Şubat 2008
Mesajlar
7
Excel Vers. ve Dili
MS Office 2003 TR
Çok teşekkür ederim ama bakıyorum bakıyorum ne anlatıldığına dair pek bir fikrim yok. Yani örnek uygulamalarda da bahsettiğim şekilde bir erişim göremedim. Excelde hiç bir bilgim yok açıkçası. Ekteki dosyaya bahsettiğim şekilde bir uyarlama yapamazmısınız?

Şimdiden teşekkürler.
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,444
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

2 örnek yaptım, gerisini siz üzerinde çalışırsınız.
 

Ekli dosyalar

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Kabini kabin sayfasına kokpitide kokpit sayfasına aktarır.
Dosya ekte.:cool:
Kod:
Sub aktar()
Dim s1 As Worksheet, s2 As Worksheet
Dim sat1 As Long, sat2 As Long, i As Byte
Sheets("Ucus Tablosu").Select
Set s1 = Sheets("Cockpit Listesi")
Set s2 = Sheets("Kabin Listesi")
If MsgBox("COCKPIT VE CABIN aktarımını yapmak istiyormusunuz?", vbYesNo, "AKTAR") = vbNo Then Exit Sub
sat1 = s1.Cells(65536, "A").End(xlUp).Row + 1
sat2 = s2.Cells(65536, "A").End(xlUp).Row + 1
For i = 4 To 12
    If Cells(i, "A").Value = "COCKPIT" Then
        If sat1 >= 65533 Then
            MsgBox "Cockpit sayfasında satır doldu.Bu sayfaya başka kayıt yapılamaz.Kayıtlar tam olarak akatarılmadı..", vbCritical, "UYARI"
            GoTo atla:
            Else
            s1.Range("A" & sat1 & ":G" & sat1).Value = _
            Range("A" & i & ":G" & i).Value
            sat1 = sat1 + 1
        End If
    ElseIf Cells(i, "A").Value = "CABIN" Then
        If sat2 >= 65533 Then
            MsgBox "Kabin sayfasında satır doldu.Bu sayfaya başka kayıt yapılamaz.Kayıtlar tam olarak akatarılmadı..", vbCritical, "UYARI"
            GoTo atla:
            Else
            s2.Range("A" & sat2 & ":G" & sat2).Value = _
            Range("A" & i & ":G" & i).Value
            sat2 = sat2 + 1
        End If
    End If
atla:
Next
MsgBox "Akatrım Bitti.", vbOKOnly + vbInformation, "AKTARIM"
            
End Sub
 

Ekli dosyalar

Katılım
7 Şubat 2008
Mesajlar
7
Excel Vers. ve Dili
MS Office 2003 TR
Evren Bey, teşekkürler.
Necdet Bey size ayrıca teşekkürler. Istediğim tamamen buydu :) ellerinize sağlık. Tekrar saygılarımla, sağlıcakla kalın.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Evren Bey, teşekkürler.
Necdet Bey size ayrıca teşekkürler. Istediğim tamamen buydu :) ellerinize sağlık. Tekrar saygılarımla, sağlıcakla kalın.
Rica ederim.
İyi çalışmalar.:cool:
 
Üst