Soru Arama işleminde devamındaki satırdan devam etme

[dengeceteris]

Sevgili Forum üyeleri sık sık kullandığımız uzun bir liste var ben bunu özet olarak yükledim. soruma gelince 2 ayrı tablom var ve bunlar 3 sütundan oluşuyor. Birinci tablom DATASOFT ikinci tablom MİKRO birde bunları karşılaştırdığım ÇALIŞMA isimli tablo var. Şimdi mesela bir personel 2 ayrı kanundan yararlanıyorsa bunlardan birisi 5510 diğeri 5746 ben bunları ÇALIŞMA sayfasına DÜŞEYARA ile çekiyorum. Ama problemim bu formülü kullanırken ilk gördüğü kanunu DÜŞEYARA ile getiriyor. Benim bunu bir tc iki defa geçiyorsa satırın birinde 5510'u bulduysa artık ikinci satırda 5746'yı getirme gibi bir imkan var mıdır. Mümkünse ÇALIŞMA sayfasına bulmaya çalıştığım satırları koydum. Yardımcı olacabilecek uzman arkadaşlarıma şimdiden tşk ederim.

 

[Mahir64]

Merhaba,

C4 hücresinde DİZİ Formülü olarak deneyiniz.

=EĞERHATA(İNDİS('DATASOFT '!$C$2:$C$1000;KÜÇÜK(EĞER(A4='DATASOFT '!$A$2:$A$1000;SATIR('DATASOFT '!$A$2:$A$1000)-SATIR('DATASOFT '!$A$2)+1);EĞERSAY($A$4:$A4;$A4)));"")

Mikro sayfası için sayfa adını değiştirin. Eğer sayfa isimleriniz daha fazlaysa DOLAYLI formülünü kullanabilirsiniz.

 

[YUSUF44]

Formülle nasıl olur bilemedim ama aşağıdaki kodları ÇALIŞMA sayfasının kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırırsanız A4:A100 aralığına girdiğiniz verilere göre istediğinzi işlem yapılır. Öncesinde DATASOFT sayfasının sayfa adının sonunda bir boşluk var, onu silmeniz gerekir:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A4:A100]) Is Nothing Then Exit Sub
Set s1 = Sheets("DATASOFT")
Set s2 = Sheets("MİKRO")
sonD = s1.Cells(Rows.Count, "A").End(3).Row
sonM = s2.Cells(Rows.Count, "A").End(3).Row
eski = Cells(Rows.Count, "A").End(3).Row
On Error GoTo bit
If Selection.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
a = Target.Row
'If eski > 4 Then
'    Range("A5:C" & eski).ClearContents
'End If
Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""
Application.ScreenUpdating = False
    If WorksheetFunction.CountIf(s1.Range("A1:A" & sonD), Target) > 0 Then
        sorgu = "select distinct [kanun] from [DATASOFT$] where [tckno]=" & Target & " "
        Set rs = con.Execute(sorgu)
        yeniB = Cells(Rows.Count, "B").End(3).Row + 1
        Cells(yeniB, "B").CopyFromRecordset rs
    Else
        GoTo 10
    End If
10:
    If WorksheetFunction.CountIf(s2.Range("A1:A" & sonM), Target) > 0 Then
        sorgu = "select distinct [kanun] from[MİKRO$] where [tckno]=" & Target & " "
        Set rs = con.Execute(sorgu)
        yeniC = Cells(Rows.Count, "C").End(3).Row + 1
        Cells(yeniC, "C").CopyFromRecordset rs
    Else
        GoTo bit
    End If
    son = WorksheetFunction.Max(Cells(Rows.Count, "B").End(3).Row, Cells(Rows.Count, "C").End(3).Row)
    If son > 4 Then
        Range("A" & a & ":A" & son) = Target
        Cells(son + 1, "A").Select
    End If
bit:
Application.ScreenUpdating = True
End Sub

 

[dengeceteris]

Sevgili Hocam tşk ederim işimi gördü.. çok sağolun

 

[dengeceteris]

Yusuf hocam dediğinizi yaptım ama herhangi bir tepki oluşmadı makronun çalışmasında

 

[dengeceteris]

 

[Mahir64]

tşk ederim

Teşekkür ederim.

İyi çalışmalar.