AccessTr.neT

Tam Versiyon: Asgari Geçim
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Sayfalar: 1 2 3
Kodu alttaki gibi deneyin abey.

Sub getir()
    Dim son As Long, i As Long, ind As String, kac As Long
    agitutarý.Value = ""
    If cocuk = Empty Or medenihal = Empty Then Exit Sub
    With sh
        kac = WorksheetFunction.Match(medenihal, .Range("C:C"), 0)
        ind = WorksheetFunction.Index(.Range("C:C"), kac)
        son = .Cells(Rows.Count, "C").End(3).Row
       
        If son < 2 Then Exit Sub
        For i = kac To son
            If medenihal = WorksheetFunction.Index(.Range("C:C"), i) And Val(cocuk) = .Cells(i, 4).Value Then
                agitutarý.Value = .Cells(i, 5).Value
                Exit For
            End If
        Next
    End With
End Sub
Kodda fazlalık olmuş abey.

Sub getir()
    Dim son As Long, i As Long, kac As Long
    agitutarý.Value = ""
    If cocuk.Value = Empty Or medenihal.Value = Empty Then Exit Sub
    With sh
        On Error GoTo son
        kac = WorksheetFunction.Match(medenihal, .Range("C:C"), 0)
        son = .Cells(Rows.Count, "C").End(3).Row
       
        If son < 2 Then Exit Sub
        For i = kac To son
            If medenihal.Value = WorksheetFunction.Index(.Range("C:C"), i) And Val(cocuk.Value) = .Cells(i, 4).Value Then
                agitutarý.Value = .Cells(i, 5).Value
                Exit For
            End If
        Next
    End With
son:
End Sub
Aboo vallahi gözüm korktu.
Ben ustama dedim ki kısa olsun. Ustam döktürmüş.
Ellerine kollarına sağlık.
Kısa olmuyor işte abey Img-grin
Aslında koddaki son= ve if son gibi yerler silinebilr lakin garanti olsun diye eklendi.
Ustam kodda sıkıntı yok. Sıkıntı bende. Bende de o kodu uygulayacak kadar bilgi yok.

Eğer kısa olsaydı formda diğer uygulamalarda da kendi kendime uygulardım.
Mesela sadece kere bekar yada 1 kere eş çalışyor vb... olsydı döngüyede gerek yoktu ve daha kısa olurdu Img-grin
Sayfalar: 1 2 3