vba ile yinelenen değerler

[kalibre101]

merhabalar B sütununda aynı tarihten yazıyorsa yani yineleniyorsa
D stünunda sadece tekinde değer yazsın istiyorum vba ile yapmak mümkünmüdür yardımcı olabilirmisiniz
örnek dosya ektedir
https://drive.google.com/file/d/1HTT3mDm20DDcmbKJaVgqFOEvuttz6Ojh/view?usp=sharing
yardımcı olursanız sevinirim

 

[Muzaffer Ali]

Merhaba.
Bir modüle kopyalayıp çalıştırın.
Birinci haricinde aynı olanları D hücresini temizler.

Sub Test()
    Dim Bak As Long
    For Bak = 2 To Cells(Rows.Count, "B").End(xlUp).Row
        If WorksheetFunction.CountIf(Range("B2:B" & Bak), Cells(Bak, "B")) > 1 Then Cells(Bak, "D") = ""
    Next
End Sub

 

[kalibre101]

Merhaba.
Bir modüle kopyalayıp çalıştırın.
Birinci haricinde aynı olanları D hücresini temizler.

Sub Test()
    Dim Bak As Long
    For Bak = 2 To Cells(Rows.Count, "B").End(xlUp).Row
        If WorksheetFunction.CountIf(Range("B2:B" & Bak), Cells(Bak, "B")) > 1 Then Cells(Bak, "D") = ""
    Next
End Sub

çok teşekkür ederim oldu

 

[Muzaffer Ali]

Kolay gelsin.

 

[kalibre101]

Kolay gelsin.

hocam tekrar rahatsız ediyorum ama şöyle birşey olabilirmi acaba
D sütunundaki veriyi silmek yerine metine dönüştürebilirmi acaba böylece o sütunlar boş kalmaz D sütunundaki verilerde toplama formülünde işleme alınmaz

 

[Muzaffer Ali]

Onun yerine "x" yazdırın.
= "x"

 

[kalibre101]

Onun yerine "x" yazdırın.
= "x"

Hocam demek istediğiniz anlayamadım "X" olduğunda hücrelere X yazıyor mevcut hücre içeriğini metne çevirmek istemistim ben acaba benmi yanlış yapıyorum

 

[Muzaffer Ali]

Aşağıdaki kodu kullanın.

Sub Test()
    Dim Bak As Long
    For Bak = 2 To Cells(Rows.Count, "B").End(xlUp).Row
        If WorksheetFunction.CountIf(Range("B2:B" & Bak), Cells(Bak, "B")) > 1 Then Cells(Bak, "D") ="'" & Cells(Bak, "D")
    Next
End Sub

 

[kalibre101]

Aşağıdaki kodu kullanın.

Sub Test()
    Dim Bak As Long
    For Bak = 2 To Cells(Rows.Count, "B").End(xlUp).Row
        If WorksheetFunction.CountIf(Range("B2:B" & Bak), Cells(Bak, "B")) > 1 Then Cells(Bak, "D") ="'" & Cells(Bak, "D")
    Next
End Sub

Teşekkür ederim hayırlı günler dilerim

 

[Muzaffer Ali]

Kolay gelsin.