Hasta Listesinde Arama Yaptırma

[yesimgurol]

Merhaba,

Aşağıdaki kodları ilgili sayfanın kod bölümüne kopyalayıp dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [C:C]) Is Nothing Then Exit Sub
 
    Dim c   As Range
    Dim Adr As String
    Dim Kol As Integer
    With Worksheets(1).Range("C1:C" & Target.Row - 1)
        Set c = .Find(Target.Value, LookIn:=xlValues)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                Kol = Cells(Target.Row, Columns.Count).End(1).Column + 1
                Cells(Target.Row, Kol) = c.Offset(0, -1)
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
 
End Sub

Sayın Necdet Bey,ekte yapmış olduğunuz dosya benim için muhteşem bir olay,o açıdan hiç bir sıkıntım yok.Aslına bakarsanız bir önceki mesajda sizin anlayışınızda bir eksiklik yok bilakis benim anlatımımda bir yanlışlık olmuş.Öğrenmek istediğim sizin kodlarınıza bakarak bişeyler yapabilirmiyim diye çalıştım ama kodlardan bişey anlayamadım:-( Mesela; C sütununa hasta ismi yazınca arama yapıp aynı hastayı bulduğunda ilgili satıra yazıyor.Çok hoşuma gittiğinden birde bulmadığında ismin yazdığı hücrenin yanına "DAHA ÖNCEKİ SONUCU BULUNAMADI" yazsa çok harika olur.Yanlış anlamayın ben bu haliyle zaten muhteşem görüyorum.Yazdığım notuda ekleyebilirsek çok hoş olucak sanırım..Bu arada yeni bir sorum daha var ama dosyasını haızrlamam gerekicek yardımcı olurmusunuz?

 

[Necdet]

Merhaba,

Biz sizin işinizi ve dolayısıyla gereksinmenizi sizin kadar iyi bilemeyiz, o yüzden bizi siz yönlendirmelisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [C:C]) Is Nothing Then Exit Sub
    
    Dim c   As Range
    Dim Adr As String
    Dim Kol As Integer
    
    'Aktif hücrenin bulunduğu son dolu kolon numarası bulunur
    Kol = Cells(Target.Row, Columns.Count).End(1).Column
    If Kol < 4 Then Kol = 3
    
    If Target.Value = "" Then
        'Aktif hücre (C sütunundaki hücre) silindiyse Sonuçlar da silinir
        Range(Cells(Target.Row, "D"), Cells(Target.Row, Kol)).ClearContents
    Else
        'Yeni Hasta Girilmişse Aramayı Başlat
        With Worksheets(1).Range("C1:C" & Target.Row - 1)
            ' C1 hücresinden hedef hücrenin bir önceki sütün aralığında arama yap
            Set c = .Find(Target.Value, LookIn:=xlValues)
            If Not c Is Nothing Then
                'Eğer bulunduysa aramaya devam et
                Adr = c.Address
                Do
                    Kol = Kol + 1
                    Cells(Target.Row, Kol) = c.Offset(0, -1)
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            Else
                'Aranan hasta bulunmazsa..
                Kol = Kol + 1
                Cells(Target.Row, Kol) = "DAHA ÖNCEKİ SONUCU BULUNAMADI"
            End If
        End With
    End If
End Sub

 

[yesimgurol]

Sayın Necdet Bey,inanın çok teşekkür ederim..Bu sorunum tahmin edemeyeceğim kadar güzel çözüldü sayenizde..

Bir sorum daha var ama sanırım bu vaktinizi alıcak sanırım biraz zahmetli ben anlatmaya çalıştım ekteki dosyada ,yapılabilir mi? Yapılamaz mı? Fikrinizi almak isterim.Ekteki dosyada bulunan "liste"adlı çalışma kitabında açıklama yapmıştım.

 

[Necdet]

Merhaba,

Sayın yesimgurol,

Farklı konuları farklı konu başlığı ile açınız. Zira bu konuyu inceleyen arkadaşlar yeteri kadar yazışma olmuş o zaman sorun çözülmüştür düşüncesiyle konuyu incelemeyebilirler.

Ben kendi adıma sorunuzu pek anlamadım. Daha önceki mesajımda da dediğim gibi konu bizim açımızdan bilinmeyen bir konu.

Tek anladığım şey Liste sayfasındaki bilgileri başka dosyalara yazdırmak ama o başka dosyaları incelediğimde içinden çıkamayacağım kadar sayfaları olan bir dosya. Buradaki bilgileri ilgili dosyada ilgili yerlere yazdırılmalı diyorsunuz. İlgili yer neresi? hangi sayfa vs vs vs.

Daha açıklayıcı bilgi ile yeni konu açınız.

 

[yesimgurol]

Haklısınız,ben yeniden düzenleyip tekrar konu açarak ekleyeyim.