• DİKKAT

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

Satır ve Sütundaki değerlere göre veri bulma

Katılım
14 Kasım 2016
Mesajlar
170
Excel Vers. ve Dili
2016
İyi çalışmalar. Yapmak istediğim çalışma biraz karışık. Bu sebeple tablo örneği paylaşıyorum. Böyle bir çalışma yapılabilir mi?
Teşekkür ediyorum.

 

Ekli dosyalar

Merhaba deneyiniz..


Sayfanın kod bölümüne , ay değişikliğinde çalışır.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("AJ5")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    Dim Syf As Worksheet, i As Integer, x As Integer, bulTarih, bulAd
    Range("F10:AJ110").ClearContents
    On Error Resume Next
    Set Syf = Sheets(Range("AJ5").Value)
    For i = 6 To 36
        If Cells(9, i) <> "" Then
            Set bulTarih = Syf.Range("A7:A100").Find(Cells(9, i), , xlValues, xlWhole)
            If Not bulTarih Is Nothing Then
                For x = 3 To 4
                    If Syf.Cells(bulTarih.Row, x) <> "" Then
                        Set bulAd = Range("C10:C110").Find(Syf.Cells(bulTarih.Row, x), , xlValues, xlWhole)
                        If Not bulTarih Is Nothing Then
                            Cells(bulAd.Row, i) = "+"
                        End If
                    End If
                Next
            End If
        End If
    Next
    MsgBox "islem tamam"
End Sub
 

Ekli dosyalar

Merhaba deneyiniz..


Sayfanın kod bölümüne , ay değişikliğinde çalışır.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("AJ5")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    Dim Syf As Worksheet, i As Integer, x As Integer, bulTarih, bulAd
    Range("F10:AJ110").ClearContents
    On Error Resume Next
    Set Syf = Sheets(Range("AJ5").Value)
    For i = 6 To 36
        If Cells(9, i) <> "" Then
            Set bulTarih = Syf.Range("A7:A100").Find(Cells(9, i), , xlValues, xlWhole)
            If Not bulTarih Is Nothing Then
                For x = 3 To 4
                    If Syf.Cells(bulTarih.Row, x) <> "" Then
                        Set bulAd = Range("C10:C110").Find(Syf.Cells(bulTarih.Row, x), , xlValues, xlWhole)
                        If Not bulTarih Is Nothing Then
                            Cells(bulAd.Row, i) = "+"
                        End If
                    End If
                Next
            End If
        End If
    Next
    MsgBox "islem tamam"
End Sub
Çok teşekkür ederim. Bazı aylarda kod çalışıyor. Bazı aylarda çalışmıyor.
 
Sadece "Mart" ve "Nisan" da mı çalışıyor ?
 
Diğer aylardaki tarihlerler yanlış , mesela "OCAK" sayfasındaki tarihleri kontrol ettiğinizde mart ayının günlerini göreceksiniz , diğer sayfalarda aynı şekilde , sadece "Mart" ve "Nisan" sayfalarının tarihleri doğru , bu şekilde tekrar kontrol etmenizi rica ederim.
 
Diğer aylardaki tarihlerler yanlış , mesela "OCAK" sayfasındaki tarihleri kontrol ettiğinizde mart ayının günlerini göreceksiniz , diğer sayfalarda aynı şekilde , sadece "Mart" ve "Nisan" sayfalarının tarihleri doğru , bu şekilde tekrar kontrol etmenizi rica ederim.
Çalıştı. Çok çok teşekkür ederim.
 
Rica ederim , iyi çalışmalar..
 
Geri
Üst