makroda arama yapınca boş görünüyor

[murex4951]

Merhaba,
Benim sorum şu , Mehmet Ali yi aratınca , Serkan Hoca Coğrafya yazması gerek,boş geliyor .Sadece Serkan hocada 16:30 ders saatinden sonra bu sıkıntı çıkıyor.Yardımınızı bekliyorum. Teşekkür ederim.

 

[muhasebeciyiz]

deneyiniz

 

[muhasebeciyiz]

dosyayı güncelledim tekrar deneyiniz

aynı isimlerden çok varsa listede örneğin şuna benzer görünür

Mehmet Ali | 16:30 | Serkan Hoca Coğrafya | Coğrafya
Mehmet Ali | 14:00 | Ahmet Hoca Matematik | Matematik
Mehmet Ali | 10:30 | Ayşe Hoca Türkçe | Türkçe

 

[muhasebeciyiz]

bu versiyondada

Mehmet Ali yaz
listede kayıtlar gelsin
birine tek tıkla → haftalık tüm dersleri açılsın
çift tıkla → ilgili satıra gitsin

her iki dosyayı ayrı deneyip geri dönüş yapınız

 

[murex4951]

Merhaba
tam olarak bu şekilde değil istediğim,benim versiyonda isimleri sarıya boyuyor arama yapınca ,birde boyadığım yerde isim yazmıyor.

 

[Korhan Ayhan]

Merhaba,

Formunuzdaki tüm kodu silip aşağıdaki kodu uygulayınız.

Option Explicit
Dim Last_Row As Long

Private Sub CommandButton1_Click()
    Dim No As Long, X As Long, Bul As Range, Adres As String
    
    Application.ScreenUpdating = False
    
    Range("K1:N" & Last_Row).Clear
    Range("K1:M1") = Array("GÜN", "SAAT", "DERS")
    Range("K1:M1").Font.Bold = True
    
    No = 2
    
    For X = 2 To 8
        Set Bul = Columns(X).Find(What:="*" & Me.ComboBox1.Text, LookAt:=xlWhole, MatchCase:=False)
        If Not Bul Is Nothing Then
            Adres = Bul.Address
            Do
                Bul.Interior.ColorIndex = 6
                Cells(No, "K") = Cells(1, X)
                Cells(No, "L") = Split(Bul.Value, " ")(0)
                Cells(No, "M") = Cells(Bul.Row, 1).End(xlUp).Value
                Cells(No, "N").Font.ColorIndex = 2
                Cells(No, "N") = Bul.Address
                Range("K" & No).Resize(, 3).Borders.LineStyle = 1
                No = No + 1
                Set Bul = Columns(X).FindNext(Bul)
            Loop While Not Bul Is Nothing And Bul.Address <> Adres
        End If
    Next
    
    If Range("K2") <> "" Then
        Dim Dizi
    
        Dizi = Range("K2:N" & No - 1).Value
        
        For X = 1 To UBound(Dizi, 1)
            Dizi(X, 2) = Format(Dizi(X, 2), "hh:mm")
        Next
        
        Me.ListBox1.List = Dizi
    End If

    Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Initialize()
    Dim Day_List As String, Dizi As Variant, X As Long, Y As Long
    Dim List As New Collection, Rng As Range, Text As String
    
    Day_List = "|PAZARTESİ|SALI|ÇARŞAMBA|PERŞEMBE|CUMA|CUMARTESİ|PAZAR|"
    
    Last_Row = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    On Error Resume Next
    
    Dizi = Range("B2:H" & Last_Row).Value
    
    For X = 1 To UBound(Dizi, 1)
        For Y = 1 To UBound(Dizi, 2)
            If Dizi(X, Y) <> "" Then
                If Not IsNumeric(Dizi(X, Y)) Then
                    If InStr(1, Day_List, "|" & UCase(Trim(Replace(Replace(Dizi(X, Y), "ı", "I"), "i", "İ"))) & "|", vbTextCompare) = 0 Then
                        Text = CStr(Mid(Dizi(X, Y), InStr(1, Dizi(X, Y), " ") + 1, Len(Dizi(X, Y)) - InStr(1, Dizi(X, Y), " ")))
                        List.Add Text, Text
                        Me.ComboBox1.AddItem Text
                    End If
                End If
            End If
        Next
    Next
    
    On Error GoTo 0
    
    Me.ListBox1.ColumnWidths = "80;30;100;0"
    Me.ListBox1.ColumnCount = 4
End Sub

Private Sub ListBox1_Click()
    Range("B1:H" & Last_Row).Interior.ColorIndex = xlNone
    
    If Me.ListBox1.ListCount = 0 Then Exit Sub
    
    With Range(Me.ListBox1.Column(3))
        .Interior.ColorIndex = 6
        .Activate
    End With
End Sub

Private Sub UserForm_Terminate()
    Range("B1:H" & Last_Row).Interior.Color = xlNone
    Range("A1").Activate
End Sub

Private Sub ComboBox1_Change()
    Range("B1:H" & Last_Row).Interior.Color = xlNone
  
    If Me.ComboBox1.Value = "" Then Exit Sub
  
    Call CommandButton1_Click
End Sub