Soru Hücreye Girilen Veriyi Anımsamak

Hsn55 · 15 Mayıs 2021

Merhabalar;
Ekli dosyamda Veri Girişi sayfasında E10:E20 hücre aralığına ,Tazminat sayfasındaki C11:C500 hücre aralığındaki verilerden herhangi birinin birkaç harfini yazdığım zaman Örneğin 2 yazdığım zaman tazminat sayfasında C11:C500 hücre aralığında içerisinde 2 olan satırları Userform1 de ListBox1 içerisine alarak ve Listbox1 e gelen verilerden istediğim satırı seçip ; Veri Girişi sayfasında E10:E20 aralığında ki hangi satırda isem o satıra ilgili veriyi yazdırma mümkün müdür?
Not: Veri girişi sayfasında E10:E20 hücresinin hangi satırına veri girersem Userform1 otomatik açılacak ve Listbox1 bulunan veriler süzülmüş halde gelecek.

ANIMSAMA.xlsm

dosyayı indir, full download - ANIMSAMA.xlsm

dosya.org

Ömer · 15 Mayıs 2021

Merhaba,

Userformun kod bölümüne ekleyiniz. Listbox daki satıra çift tıklayınca E10:E20 aralığında aktif hücreye yazar.

Kod:

Dim S1 As Worksheet, S2 As Worksheet

Private Sub UserForm_Initialize()

    Dim i As Range, c As Range, Adr As String
  
    Set S1 = Sheets("VERİ GİRİŞİ")
    Set S2 = Sheets("TAZMİNAT")
  
    For Each i In S1.Range("E10:E20")
        If i <> "" Then
            Set c = S2.[C10:C500].Find(i.Value)
            If Not c Is Nothing Then
                Adr = c.Address
                Do
                    ListBox1.AddItem c.Value
                    Set c = S2.[C10:C500].FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
        End If
    Next i
      
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If Intersect(ActiveCell, S1.[E10:E20]) Is Nothing Then Exit Sub
    ActiveCell = ListBox1.List(ListBox1.ListIndex)
End Sub

.

Hsn55 · 15 Mayıs 2021

Ömer bey çok teşekkür ederim. Kod güzel çalışıyor. Şöyle bir sıkıntı var. Veri girişi sayfasında E10:E20 hücre aralığında her hücrede farklı giriş yapacağım için farklı veri süzmesi yapması gerekirken tüm hücrelere aynı süzülmüş verileri getiriyor. Örneğin :E10 hücresine 2 yazdığım zaman 2 leri süzerek verileri getirecek .Yine farklı bir hücreye örneğin E15 hücresine Çk yazdığım zaman bu seferde Çk olanları getirecek.
Birde Veri Girişi sayfasında E10:E20 hücre aralığındaki herhangi bir hücreye veri girdiğim zaman Userform otomatik açılabilir mi?

Ömer · 15 Mayıs 2021

E10:E20 aralığında herhangi 2 yada daha fazla hücreye veri girip formu açtığınızda tüm bu girilen değerler Listbox'a süzülmeyecek mi?
Şuan bunu yapıyor. Sizin açıklamanızı anlayamadım.

Hsn55 · 15 Mayıs 2021

Ömer bey E10.E20 hücre aralığına farklı seçim olacağından dolayısıyla her hücre girilen veriye göre süzülecek.
Örneğin: E10 hücresine Kn girdiğim zaman Listboxa Kn ler gelecek. Tekrar E15 hücresine Çk girdiğim zaman bu sefer Listbox Çk olanları getirecek

Ömer · 15 Mayıs 2021

Yani son girilen veriye göre süzme mi yapacak?

Hsn55 · 15 Mayıs 2021

Hsn55 · 15 Mayıs 2021

Hocam birde hücreye veri girişi ve listbox gelebilir mi

Ömer · 15 Mayıs 2021

Eski kodları silip (module1 dahil) aşağıdaki kodları ilgili bölümlerine ekleyiniz.

Veri Girişi sayfası kod bölümüne:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [E10:E20]) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    deg = Target.Value
    Target.Select
    If Target <> "" Then UserForm1.Show 0
End Sub

Userform'un kod bölümüne:

Kod:

Dim S1 As Worksheet, S2 As Worksheet

Private Sub UserForm_Initialize()

    Dim c As Range, Adr As String
    
    Set S1 = Sheets("VERİ GİRİŞİ")
    Set S2 = Sheets("TAZMİNAT")

    Set c = S2.[C10:C500].Find(deg)
    If Not c Is Nothing Then
        Adr = c.Address
        Do
            ListBox1.AddItem c.Value
            Set c = S2.[C10:C500].FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Adr
    End If

End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If Intersect(ActiveCell, S1.[E10:E20]) Is Nothing Then Exit Sub
    ActiveCell = ListBox1.List(ListBox1.ListIndex)
End Sub

Module1 in kod bölümüne:

Kod:

Public deg
Sub Düğme1_Tıklat()
    UserForm1.Show 0
End Sub

Hsn55 · 15 Mayıs 2021

Ömer bey çok şahane olmuş .Son olarak Listboxu çift tıklayıp seçim yapınca Userformdan çıkış olabilir mi?

Ömer · 15 Mayıs 2021

"Private Sub ListBox1_DblClick" kodlarındaki End Sub satırından önce aşağıdaki ilaveyi yapın.

Unload Me

.

Hsn55 · 15 Mayıs 2021

Hocam bu kodu

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [E10:E20]) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    deg = Target.Value
    Target.Select
    If Target <> "" Then UserForm1.Show 0
End Sub

Bu kodun içerisine nasıl birleştirebiliriz?

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
    Sheets("VERİ GİRİŞİ").Unprotect 1978
    
    Dim Veri As Range, Bul As Range
    
    If Not Intersect(Target, Range("D9")) Is Nothing Then
        For Each Veri In Intersect(Target, Range("D9"))
            If Veri.Value <> "" Then
                Set Bul = Sheets("KADASTROBİLGİLERİ").Range("F:F").Find(Veri.Value, , , xlWhole)
                If Not Bul Is Nothing Then
                    Range("D16").Value = Bul.Offset(, 2).Value
                Else
                    
                End If
            Else
                Range("D16").Value = ""
            End If
        Next
    ElseIf Not Intersect(Target, Range("D19")) Is Nothing Then
        For Each Veri In Intersect(Target, Range("D19"))
            If Veri.Value <> "" Then
                Set Bul = Sheets("KADASTROBİLGİLERİ").Range("F:F").Find(Veri.Value, , , xlWhole)
                If Not Bul Is Nothing Then
                    Range("D27").Value = Bul.Offset(, 2).Value
                    Range("D31").Value = Bul.Offset(, 1).Value
                Else
                  
                End If
            Else
                Range("D27").Value = ""
                Range("D31").Value = ""
            End If
        Next
    End If
Sheets("VERİ GİRİŞİ").Protect 1978
End Sub

Ömer · 15 Mayıs 2021

Deneyiniz.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)

    Sheets("VERİ GİRİŞİ").Unprotect 1978
    
    Dim Veri As Range, Bul As Range
    
    If Not Intersect(Target, [E10:E20]) Is Nothing Then
        [E10:E20].Locked = False
        [E10:E20].FormulaHidden = False
        If Target.Count = 1 Then
            deg = Target.Value
            Target.Select
            If Target <> "" Then UserForm1.Show 0
        End If
    End If
    
    If Not Intersect(Target, Range("D9")) Is Nothing Then
        For Each Veri In Intersect(Target, Range("D9"))
            If Veri.Value <> "" Then
                Set Bul = Sheets("KADASTROBİLGİLERİ").Range("F:F").Find(Veri.Value, , , xlWhole)
                If Not Bul Is Nothing Then
                    Range("D16").Value = Bul.Offset(, 2).Value
                Else
                    
                End If
            Else
                Range("D16").Value = ""
            End If
        Next
    ElseIf Not Intersect(Target, Range("D19")) Is Nothing Then
        For Each Veri In Intersect(Target, Range("D19"))
            If Veri.Value <> "" Then
                Set Bul = Sheets("KADASTROBİLGİLERİ").Range("F:F").Find(Veri.Value, , , xlWhole)
                If Not Bul Is Nothing Then
                    Range("D27").Value = Bul.Offset(, 2).Value
                    Range("D31").Value = Bul.Offset(, 1).Value
                Else
                  
                End If
            Else
                Range("D27").Value = ""
                Range("D31").Value = ""
            End If
        Next
    End If
    
    Sheets("VERİ GİRİŞİ").Protect 1978
    
End Sub

Hsn55 · 15 Mayıs 2021

Hocam asıl dosyama uyarladım. Fakat veri girişi sayfasında şu kodda hata verdi.

Kod:

[I18:I25].Locked = False

Hsn55 · 15 Mayıs 2021

Hocam hücre birleştirilmiş olduğundan hata veriyor.

Ömer · 15 Mayıs 2021

Birleştirilmiş hücre kullandığınız için.

[I18:I25] yerine [I18:N25] yazarak deneyiniz. 3 farklı yeri de bu şekilde değiştiriniz.

Not: Verileriniz gerçek veri olduğunu düşünerek eklediğiniz son dosyayı kaldırdım.

Bu arada Samsun'a selamlar. Üniversitede beş yıl öğrenciliğimde çok güzel günlerim ve hala devam eden dostluklarım oldu.

Hsn55 · 15 Mayıs 2021

Aleyküm selam hocam. Hocam makro hata vermiyor. Userform açılıyor. Fakat Listboxa veri bazen gelmiyor. Dosyadan çıkış yaptığım zaman tekrar girince oluyor. Birde Listboxtan seçim yapıp; diğer satırda arama yapınca veriler gelmiyor

Ömer · 15 Mayıs 2021

Veri girişi sayfası [I18:I25] aralığından mı bahsediyorsunuz. Ben doğrulamadan her seçim yaptığımda userform açılıyor ve seçim yapabiliyorum.
Ayrıca diğer satırdan kastınız nedir?

Hsn55 · 15 Mayıs 2021

Hocam I18 hücresine veri girip Listboxtan ilgili veriyi seçtikten sonra bir alt satırda tekrar veri girip enter tuşuna basılınca listbox veri gelmiyor

Ömer · 15 Mayıs 2021

Veri girişi kodlarındaki ilgili bölümü aşağıdaki gibi değiştirin. Module13.Düğme1_Tıklat

Kod:

    If Not Intersect(Target, [I18:N25]) Is Nothing Then
        [I18:N25].Locked = False
        [I18:N25].FormulaHidden = False
        If Target.Count = 1 Then
            deg = Target.Value
            Target.Select
            If Target <> "" Then Module13.Düğme1_Tıklat
        End If
    End If

Soru Hücreye Girilen Veriyi Anımsamak

Hsn55

ANIMSAMA.xlsm

Ömer

Moderatör

Ekli dosyalar

Hsn55

Ömer

Moderatör

Hsn55

Ömer

Moderatör

Hsn55

Hsn55

Ömer

Moderatör

Ekli dosyalar

Hsn55

Ömer

Moderatör

Hsn55

Ömer

Moderatör

Hsn55

Hsn55

Ömer

Moderatör

Hsn55

Ömer

Moderatör

Hsn55

Ömer

Moderatör