tabloyu kontrol etsin olanların karşılıkları silinsin

[fatma_07]

Merhaba ,

D2 den D1000 e kadar bazı kodlar yazılı ve karşılarında F sutununda rakamsal değerleri var. H2 den H100 e kadar benzer kodlar var. makro H stununa baksın D sutununda daki değer H de de varsa D sutunundaki değerin karşısına gelen F sutunundaki rakamı 0 yapsın istiyorum. yardımınızı rica ederim.


iyi calismalar...

 

[çıtır]

Resme göre hazırlanmış örnek dosyanız.
http://dosya.la/download/661ea40b6263eeebd255805ee40f693a.html

 

[turist]

Sayın @fatma_07 ,
Foruma hoşgeldiniz.
Aşağıdaki Kod'u kullanabilirsiniz.

Sub BulSifirla()
For a = 2 To 100
For i = 2 To 1000
If Cells(a, 8).Value = Cells(i, 4).Value Then
Cells(i, 6) = 0
End If
Next i
Next a
End Sub

Bu Linkte excel dosyası olarak uygulanmış örneği de vardır.
İnceleyebilirsiniz

 

[fatma_07]

çok teşekkür ederim ellerinize sağlık...

 

[fatma_07]

Resme göre hazırlanmış örnek dosyanız.
http://dosya.la/download/661ea40b6263eeebd255805ee40f693a.html

dosyanizi indiremiyorum. virus programi engelliyor. we transfer gibi bir sey yaparsaniz cok sevinirim. turist bey in yaniti calisiyor. satir sayisi artikca yavas olsa da isimi gordu. tecrube acisindan sizin birikiminizden de yararlanmak isterim. tekarr tesekkurler

 

[Ömer BARAN]

Merhaba.
Alternatif olsun.

Sub BARAN()
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
alan = "H2:H" & Cells(Rows.Count, "H").End(3).Row
For dsat = 2 To Cells(Rows.Count, "D").End(3).Row
    If Cells(dsat, "D") <> "" And _
        WorksheetFunction.CountIf(Range(alan), Cells(dsat, "D")) > 0 Then Cells(dsat, "F") = 0
Next
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı.", vbInformation, "..::.. Ömer BARAN ..::.."
End Sub

 

[fatma_07]

Merhaba.
Alternatif olsun.

Sub BARAN()
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
alan = "H2:H" & Cells(Rows.Count, "H").End(3).Row
For dsat = 2 To Cells(Rows.Count, "D").End(3).Row
    If Cells(dsat, "D") <> "" And _
        WorksheetFunction.CountIf(Range(alan), Cells(dsat, "D")) > 0 Then Cells(dsat, "F") = 0
Next
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı.", vbInformation, "..::.. Ömer BARAN ..::.."
End Sub

Cok tesekkur ederim... cok iyi calisiyor

 

[Ömer BARAN]

Cok tesekkur ederim... cok iyi calisiyor

Kolay gelsin.
.