Sütunları karşılaştır.

[simetri.]

Merhabalar, cümleten iyi geceler.

Aşağıdaki bilgiler dahilinde. Yardımlarınızı bekliyorum.

Değerli forum sakinleri. Yardım edecek arkadaşlara şimdiden teşekkürler.

D ve E sütunlarını A ve B sütununda kontorl ettirip

olanların yanına " var " yazdırmamız lazım.

D ve E sütunundaki Musa Aslantürk

A ve B sütununda Aslantürk Musa olarak bulunmuş bu

durum çoğu isimlerde var. Bu durumda da "var" yazılacak.

Bunun haricinde nokta farkı dahi olsa "var" yazılmayacak.


NOT: Liste bir hayli uzun. Mümkün mertebe kod ne kadar hızlı

olursa o kadar makbule geçecektir.

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Sub ISIM_KONTROL()
    Dim X As Long, Son As Long
        
    Application.ScreenUpdating = False
    
    Son = Cells(Rows.Count, 1).End(3).Row
    Range("F3:F" & Rows.Count).ClearContents
    
    With Range("C2:C" & Son)
        .Formula = "=A2&B2"
        .Value = .Value
    End With
    
    For X = 3 To Cells(Rows.Count, 4).End(3).Row
        If WorksheetFunction.CountIf(Range("C:C"), Cells(X, 4) & Cells(X, 5)) > 0 Then
            Cells(X, 6) = "Var"
        End If
    Next
    
    Range("C2:C" & Rows.Count).ClearContents
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[simetri.]

Gününüz aydın olsun, Sayın Korhan AYHAN.

D ve E sütunundaki Musa Aslantürk

A ve B sütununda Aslantürk Musa olarak bulunmuş bu

durum çoğu isimlerde var. Bu durumda da "var" yazılacak.

Değerli Hocam, A sütununa Soyad yazıldığı durumlarda

"var" yazmıyor. Tekrar bakabilirmisiniz lütfen.

 

[Korhan Ayhan]

Aşağıdaki gibi deneyiniz.

Sub ISIM_KONTROL()
    Dim X As Long, Son As Long
        
    Application.ScreenUpdating = False
    
    Son = Cells(Rows.Count, 1).End(3).Row
    Range("F3:F" & Rows.Count).ClearContents
    
    With Range("H2:H" & Son)
        .Formula = "=A2&B2"
        .Value = .Value
    End With
    
    With Range("I2:I" & Son)
        .Formula = "=B2&A2"
        .Value = .Value
    End With
    
    For X = 3 To Cells(Rows.Count, 4).End(3).Row
        If WorksheetFunction.CountIf(Range("H:I"), Cells(X, 5) & Cells(X, 4)) > 0 Then
            Cells(X, 6) = "Var"
        End If
        If WorksheetFunction.CountIf(Range("H:I"), Cells(X, 4) & Cells(X, 5)) > 0 Then
            Cells(X, 6) = "Var"
        End If
    Next
    
    Range("H2:I" & Rows.Count).ClearContents
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[simetri.]

Merhabalar,

Sayın Korhan AYHAN.

Kod çalıştı sorun yok şuanda. Lakin kodun içinde çalıştığımız alanın dışında

hücre adresleri var. Ben kodu başka dosyalarda da kullanacağım için diğer

dosyalarda sorun çıkar kaygısı taşıyorum. Lütfen ekteki dosya ya bakabilirmisiniz.

Orada maruzatım daha net gözükecektir.