• DİKKAT

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

Soru Hücreye Girilen Veriyi Anımsamak

  • Konbuyu başlatan Konbuyu başlatan Hsn55
  • Başlangıç tarihi Başlangıç tarihi
H

Hsn55

Katılım
7 Şubat 2021
Mesajlar
594
Excel Vers. ve Dili
2010, Türkiye
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 dosya.org
 
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

.
 

Ekli dosyalar

Ö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?
 
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.
 
Ö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
 
Yani son girilen veriye göre süzme mi yapacak?
 
Hocam birde hücreye veri girişi ve listbox gelebilir mi
 
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
 

Ekli dosyalar

Ömer bey çok şahane olmuş .Son olarak Listboxu çift tıklayıp seçim yapınca Userformdan çıkış olabilir mi?
 
"Private Sub ListBox1_DblClick" kodlarındaki End Sub satırından önce aşağıdaki ilaveyi yapın.

Unload Me

.
 
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
 
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
 
Hocam asıl dosyama uyarladım. Fakat veri girişi sayfasında şu kodda hata verdi.

Kod: 
[I18:I25].Locked = False
 
Moderatör tarafında düzenlendi:
Hocam hücre birleştirilmiş olduğundan hata veriyor.
 
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.
 
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
 
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?
 
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
 
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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst