eğer değer yok ise tablo sonuna ekleme

[ulucc]

Arkadaşlar Merhaba,

sürekli olarak tablo yapmak durumunda kaldığım bir işte çalışıyorum. Bu konuda biraz yardımınıza ihtiyacım var.

H sütununda olan bir yazı A sütununda herhangi bir hücre ile eşleşiyorsa E sütunu + 1 yapmalıyım.

Eğer hiçbir hücre ile de eşleşmiyorsa tablonun a sütununun en alt kısmına H sütunundaki yazıyı eklemem gerekiyor.

Ben işin içinden bir türlü çıkamadım. çok fazla kalem var ve tek tek bitmiyor.
Yardımcı olabilir misiniz?

https://drive.google.com/file/d/0B78rrHg1_VL1NXAyUEZLM0Jfa2s/view?usp=sharing

teşekkürler,

Uluç

 

[Ömer]

Merhaba,

Anladığım:

H2 değerini A sütununda arar, bulursa bulduğu satırın E sütunundaki karşılıklarına +1 sayı ekler. Bulamazsa A sütununda son boş hücreye H2 değerini ekler.

Sub Bul_Ekle()
    
    Dim c As Range, Adr As String, son As Long
    
    son = Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    With [A:A]
        Set c = .Find([H2], , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                Cells(c.Row, "E") = Cells(c.Row, "E") + 1
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        Else
            Cells(son, "A") = Range("H2")
        End If
    End With
    
End Sub

.

 

[ulucc]

Merhaba,

ilginiz için çok teşekkür ederim. ek birşey sormak istiyorum örneğin sayfa1 deki bir değeri sayfa iki içinde aynı şartlarda aratmak istesem nasıl yapabilirim?

 

[Ömer]

Sayfa adlarını tanımlayıp hücrelerde kullanmanız yeterli olur.

Sayfa2 B1 deki değeri Sayfa1 de aynı tabloda arayarak, aynı işlemleri yapar.

Sub Bul_Ekle()
    
    Dim c As Range, Adr As String, son As Long
    Dim S1 As Worksheet, S2 As Worksheet
    
    Set S1 = Sheets("Sheet1")
    Set S2 = Sheets("Sheet2")
    
    son = S1.Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    With S1.[A:A]
        Set c = .Find(S2.[B1], , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                S1.Cells(c.Row, "E") = S1.Cells(c.Row, "E") + 1
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        Else
            S1.Cells(son, "A") = S2.Range("B1")
        End If
    End With
    
End Sub

.