• DİKKAT

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

istenilen satırı çağırma

Katılım
11 Temmuz 2007
Mesajlar
132
Excel Vers. ve Dili
2007
Merhaba değerli arkadaşlar,
"A" sütününda 700 öğrenci adı soyadı,"B" sutününda 1.yazılı notu,"C" sutününda 2.yazılı notu...3.yaz notu. ..vs o şekilde devam ediyor. Amacım "M1" hücresine ismini yazdığım öğrencinin ilgili satırı(bilgileri) gelsin..istiyorum.." M1" hücresi yerine MesageBox ta olabilir.

Teşekkür ederim.
 

Ekli dosyalar

Merhaba değerli arkadaşlar,
"A" sütününda 700 öğrenci adı soyadı,"B" sutününda 1.yazılı notu,"C" sutününda 2.yazılı notu...3.yaz notu. ..vs o şekilde devam ediyor. Amacım "M1" hücresine ismini yazdığım öğrencinin ilgili satırı(bilgileri) gelsin..istiyorum.." M1" hücresi yerine MesageBox ta olabilir.

Teşekkür ederim.

Merhaba,

Çalışma sayfasının kod bölümüne kopyalayınız.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim c As Range
 
    If Intersect(Target, [M1]) Is Nothing Then Exit Sub
 
    If Target = "" Then Exit Sub
 
    Set c = Range("A:A").Find(Target, , xlValues, xlWhole)
 
    If Not c Is Nothing Then
        MsgBox Target & Chr(10) & "Yaz1: " & Cells(c.Row, "B") _
        & Chr(10) & "Yaz2: " & Cells(c.Row, "C") & Chr(10) & "Yaz3: " & _
            Cells(c.Row, "D") & Chr(10) & "Yaz4: " & Cells(c.Row, "E")
    Else
        MsgBox "Girilen Değeri Bulamadım"
    End If
 
End Sub
.
 
Değerli Ömer arkadaşım.
Dediğiniz kodu ilgili sayfamın Modülüne yapıştırdım/çalıştırdım/ benden makro ismini soruyor..
nasıl olacak ?
teşekkürler
 
Kodlar hücre tetiklemesi ile çalışmaktadır. M1 hücresine değer girince makro otomatik çalışır.
 
M1 hücresine yazdıklarım,kodun altına yazılmakta aşağıdaki gibi. Çalıştırır ken üst menüdeki yeşil küçük oka yada F5 e basiyorum...

Range("M1").Select
Selection.ClearContents
ActiveCell.FormulaR1C1 = "zzz2"
Range("P10").Select
 
Ben konuyu yanlış mı anladım.?

Dosyayı açıp M1 hücresine bir değer girin.

.
 

Ekli dosyalar

Tamam oldu..Eline sağlık.
Ben ofis 2007 kullanıyorum.Görünüm/Makro görüntüle/ girince makro göremedim..Makroyu nereye yapıştırdınız?
**Ayrıca sonuçlar mesajbox olarak görünmekte..Bunun yerine sonucu "M2" gibi bir hücreye yazmak mümkün mü ?
Tekrar teşekkür ediyorum..
 
Kodlarda,

MsgBox

yazan bölüme,

Range("M2") =

yazarsanız istediğiniz olur.

Kodları görmek için, sayfa adı üzerine fare ile sağ klik yapın ve "kodları görüntüle" seçeneğini seçin.

.
 
Evet süpersiniz.. Eline ,aklına sağlık.Sizden çok şey öğrendim..
Dediğiniz gibi yaptım..M2 satırı aşağıya doğru çok açıldı.şimdi m2 içinde yana yana yada m2,n2,o2,p2 ye yazdırmayı deneyeceğim..
teşekkürler.
 
Aşağı açılmasını istemiyorsanız kodlardaki,

& Chr(10)

bölümleri silmeniz yeterli olur.

Farkı hücrelere yazmak için siz deneyin olmazsa ben yazarım.

.
 
Değerli Ömer Üstadım,
Merakımı bağışlayın. A sutünuna öğrenci ismlerini B sutununa da soyadlarını yazdım.İşler karıştı.Şİmdi M1 hücresine hem A daki ismi hem de b deki soyadını yazarak istenilen/ilgili satırdaki verilere M2 de yan yan yazdırmak istiyorum..Kodla oynadım fakat Target değişkenine Target2 değişkenini ilave ettim sorun verdı..
Teşekkür ettim
 
Değerli Ömer A sutünuna öğrenci ismlerini B sutununa da soyadlarını yazdım.İşler karıştı.


Kodları aşağıdakilerle değiştirin. Kırmızı alana sadece Yaz1 i yazdım, aynı mantıkla geri kalanını diğer mesajdaki gibi siz doldurursunuz.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim c As Range, ilkadres As Variant, ad As String, soyad As String
 
    If Intersect(Target, [M1]) Is Nothing Then Exit Sub
    If Target = "" Then Range("M2").ClearContents: Exit Sub
 
    On Error GoTo atla:
    ad = Split(Target, " ")(0)
    soyad = Split(Target, " ")(1)
 
    With Range("A:A")
        Set c = .Find(ad, , xlValues, xlWhole)
        If Not c Is Nothing Then
            ilkadres = c.Address
            Do
                If Cells(c.Row, "B") = soyad Then
                    [COLOR=red]Range("M2") = Target & " Yaz1: " & Cells(c.Row, "C")[/COLOR]
                End If
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> ilkadres
        Else
            Range("M2") = "Bulamadım"
        End If
    End With
 
    Exit Sub
atla:
    MsgBox "Girilen Değer Hatalı"
End Sub
.
 
Teşekkürler ..Her eve lazımsın...hocam..
 
Geri
Üst