şayet A ve R sütunlarında S3:U35 sütünun daki rakamların aynısı varsa sil

[imyourfate]

Değerli arkadaşlar hepinize hayırlı işler diliyorum
söyle bir sorunum vardı :
şayet A ve R sütunlarında; S3:U35 sütünun daki rakamların aynısı varsa A ve R sütunlarındaki bu aynı rakamları silinsin

Böyle bişey yapmak mümkünmüdür?
ekli dosya mevcuttur

Saygılarımı sunuyorum

 

[İhsan Tank]

Değerli arkadaşlar hepinize hayırlı işler diliyorum
söyle bir sorunum vardı :
şayet A ve R sütunlarında; S3:U35 sütünun daki rakamların aynısı varsa A ve R sütunlarındaki bu aynı rakamları silinsin

Böyle bişey yapmak mümkünmüdür?
ekli dosya mevcuttur

Saygılarımı sunuyorum

Merhaba
Bunu giriş yaparken mi istiyorsunuz tam açıklamamışsınız ondan ben giriş yaparken uyarı versin diye ayarlayın.
Veri Aralığını seçin ( A3:R39 gibi )
Üst sekmelerden Veri - Doğrulama - Ayarlar - İzin Verilen'den Özel'i seçin - Formül Kutucuğuna

=EĞERSAY($S$3:$U$35;A3)<>1

Bu formülü yazın. ÜSt Sekmelerden Hata Uyarısı kısmını dilediğiniz bilgi ile doldurun.

 

[imyourfate]

Hocam ilginize teşekkür ederim
S,T,U sütunlarına bilgi girdikten sonra bir buton yardımıyla A ve R sütunlarındaki aynı rakamlar silinsin istiyorum

söyle bir macro kullandım A ve R sütunlarında uygun yerlere Ç harfi koymuştum
aynısını yapmak istedim ama olmadı

Sub varsa1()
Dim sat As Long, i As Long, sat2 As Long, k As Long
sat2 = Cells(Rows.Count, "y").End(xlUp).Row
Application.ScreenUpdating = False
For k = 1 To 18 Step 17
sat = Cells(Rows.Count, k).End(xlUp).Row
For i = 2 To sat
If WorksheetFunction.CountIf(Range("y5:y" & sat2), Cells(i, k)) > 0 Then
Cells(i, k).Value = Cells(i, k).Value & " Ç"
End If
Next i
Next k
Application.ScreenUpdating = True
End Sub

 

[İhsan Tank]

Hocam ilginize teşekkür ederim
S,T,U sütunlarına bilgi girdikten sonra bir buton yardımıyla A ve R sütunlarındaki aynı rakamlar silinsin istiyorum

söyle bir macro kullandım A ve R sütunlarında uygun yerlere Ç harfi koymuştum
aynısını yapmak istedim ama olmadı

Sub varsa1()
Dim sat As Long, i As Long, sat2 As Long, k As Long
sat2 = Cells(Rows.Count, "y").End(xlUp).Row
Application.ScreenUpdating = False
For k = 1 To 18 Step 17
sat = Cells(Rows.Count, k).End(xlUp).Row
For i = 2 To sat
If WorksheetFunction.CountIf(Range("y5:y" & sat2), Cells(i, k)) > 0 Then
Cells(i, k).Value = Cells(i, k).Value & " Ç"
End If
Next i
Next k
Application.ScreenUpdating = True
End Sub

Merhaba
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub eşit_sil_61()
Dim ts, kaplan, trabzonspor, hamsi As Date
trabzonspor = MsgBox("Aralıktaki Aynı Verileri Siliyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
For ts = 3 To Cells(Rows.Count, "A").End(xlUp).Row
For kaplan = 1 To 18
If WorksheetFunction.CountIf(Range("S3:U35"), Cells(ts, kaplan)) > 0 Then
Cells(ts, kaplan).ClearContents
End If
Next
Next
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& " Sürede Silme İşlemi Tamamlandı", , "Bitiş"
End Sub

 

[imyourfate]

Hocam Allah senden razı olsun müthiş bir çalışma
Hayırlı işler diliyorum Allah'a emanet olun

Saygılarımı sunuyorum

 

[İhsan Tank]

Hocam Allah senden razı olsun müthiş bir çalışma
Hayırlı işler diliyorum Allah'a emanet olun

Saygılarımı sunuyorum

Sizdende Allah Razı Olsun
Sizde Allaha Emanet Olun
:keyif: