Farklı sütunlardaki tekrarlanan değerleri bulma ve silme

[ceylankral]

merhaba arkadaşlar,
ben farklı sütunlarda kendini tekrar eden değerleri bulup silmek istiyorum.
örnek çalışma ektedir.Örnek çalışmada b2 ve c5 hücrelerinde aynı değer var. bu değerleri silmek istiyorum. burdaki amacım, faturanın bedeli ödendiği için o değerleri toplam değerde görmek istemiyorum, ki hangi faturaların ödenmediğini görebileyim.

yani kısaca söylersem, tablo içerisinde kendini tekrar eden değerlerin bulunup silinmesini istiyorum. "yinelenenleri kaldır" ı deniyorum ama tekrarlanan değer yok diyor. oysa tabloda tekrarlanan sayılar var.

şimdiden teşekkürler.

http://s8.dosya.tc/server4/phcxrt/Kitap1.xls.html

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Tekrarlari_Sil()
    
    Dim alan As Range, c As Range, dizi(), a As Long, i As Long
    
    Set alan = Range("[COLOR="Red"]B1:C5[/COLOR]")
    
    For Each c In alan
        If c <> 0 Then
            If WorksheetFunction.CountIf(alan, c) > 1 Then
                ReDim Preserve dizi(a)
                dizi(a) = c.Address
                a = a + 1
            End If
        End If
    Next c
    
    If a = 0 Then Exit Sub
    For i = 0 To UBound(dizi)
       Range(dizi(i)).ClearContents
    Next i

End Sub

.

 

[Cibali]

Merhaba hocam,
Konu açıkken bende Tekrar eden hücreleri Farklı bir Sütunda yukarıdan aşağıya doğru hücre numaraları ile birlikte listemek istersek nasıl yaparız,
Mesela a-b-c-d sütunlardaki benzer hücreleri G hücresinde tekrar eden sayı H hücresinde hangi hücre olduğu ( b12, c25 ) gibi,
Teşekkürler.

 

[Ömer]

Bu şekilde deneyin.

Sub Tekrarlari_Listele()
    
    Dim alan As Range, c As Range, dizi(), a As Long, i As Long, son As Long
    
    son = Range("B:D").Cells.Find("*", , , , xlByRows, xlPrevious).Row
    Set alan = Range("B1:D" & son)
    
    For Each c In alan
        If c <> 0 Then
            If WorksheetFunction.CountIf(alan, c) > 1 Then
                ReDim Preserve dizi(a)
                dizi(a) = c.Address(0, 0)
                a = a + 1
            End If
        End If
    Next c
    
    If a = 0 Then Exit Sub
    For i = 0 To UBound(dizi)
       Cells(i + 2, "G") = Range(dizi(i))
       Cells(i + 2, "H") = dizi(i)
    Next i

End Sub

.