Üç Sütuna Girilen Verilerde Mükerrer

[dragon44760]

C sütununa T.C.Kimlik Numaraları girilmekte ve bu sütunda Sn. Ali hocanın mükerrer örneğinden faydalanarak mükerrer veri girişini engelledim.

Lakin;
K sütununa "Ş.KODU"
L sütununa "HESAP NO"
M sütununa "HESAP UZANTISI"
girilmekte. K, L ve M sütunlarına girilen bu bilgiler kişinin hesabını oluşturmaktadır. Ancak bir satırda bu üç sütuna girilen verilerin aynısı başka bir satırda girilmemesi gerekmektedir. C sütunundaki gibi kopyala-yapıştır, veri girişi gibi yöntemlerin hiçbirinde mükerrer veri girişi yapılmamalıdır.

İlgilenen herkese şimdiden teşekkürler...

Kolay gelsin...

 

[halit3]

C sütununa T.C.Kimlik Numaraları girilmekte ve bu sütunda Sn. Ali hocanın mükerrer örneğinden faydalanarak mükerrer veri girişini engelledim.

Lakin;
K sütununa "Ş.KODU"
L sütununa "HESAP NO"
M sütununa "HESAP UZANTISI"
girilmekte. K, L ve M sütunlarına girilen bu bilgiler kişinin hesabını oluşturmaktadır. Ancak bir satırda bu üç sütuna girilen verilerin aynısı başka bir satırda girilmemesi gerekmektedir. C sütunundaki gibi kopyala-yapıştır, veri girişi gibi yöntemlerin hiçbirinde mükerrer veri girişi yapılmamalıdır.

İlgilenen herkese şimdiden teşekkürler...

Kolay gelsin...

bunu denermisiniz

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("k:m")) Is Nothing Then Exit Sub
sat = Worksheets(ActiveSheet.Name).[c65536].End(3).Row
For i = 2 To sat - 1
ARANAN = Sheets(ActiveSheet.Name).Cells(i, 11).Value & Sheets(ActiveSheet.Name).Cells(i, 12).Value & Sheets(ActiveSheet.Name).Cells(i, 13).Value
BULUNAN = Sheets(ActiveSheet.Name).Cells(sat, 11).Value & Sheets(ActiveSheet.Name).Cells(sat, 12).Value & Sheets(ActiveSheet.Name).Cells(sat, 13).Value
If ARANAN = BULUNAN Then
Sheets(ActiveSheet.Name).Cells(sat, 11).Value = ""
Sheets(ActiveSheet.Name).Cells(sat, 12).Value = ""
Sheets(ActiveSheet.Name).Cells(sat, 13).Value = ""
End If
Next i
End Sub

 

[dragon44760]

Worksheet_SelectionChange da iki kodu aynı anda kullanmak

Hocam verdiğiniz kod gayet güzel çalışmakta ama C sütununda T.C.Kimlik numaralarının mükerrer girilmemesi için aşağıdaki kodu da kullanmam gerekiyor. Aşağıdaki kodla sizin yazmış olduğunuz kodu bir arada nasıl kullanabilirim_?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For c = [C65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("C2:C" & c), Cells(c, "C")) > 1 Then
Set a = Cells(c, "c")
Set b = Cells(c, "c").Offset(0, 20)
Range(a, b).ClearContents
End If
Next
End Sub

 

[halit3]

Hocam verdiğiniz kod gayet güzel çalışmakta ama C sütununda T.C.Kimlik numaralarının mükerrer girilmemesi için aşağıdaki kodu da kullanmam gerekiyor. Aşağıdaki kodla sizin yazmış olduğunuz kodu bir arada nasıl kullanabilirim_?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For c = [C65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("C2:C" & c), Cells(c, "C")) > 1 Then
Set a = Cells(c, "c")
Set b = Cells(c, "c").Offset(0, 20)
Range(a, b).ClearContents
End If
Next
End Sub

bu kodu denermisiniz

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("c:c,k:m")) Is Nothing Then Exit Sub
sat = Worksheets(ActiveSheet.Name).[C65536].End(3).Row
sat1 = Worksheets(ActiveSheet.Name).[K65536].End(3).Row
For j = 2 To sat - 1
ARANAN1 = Sheets(ActiveSheet.Name).Cells(j, 3).Value
BULUNAN1 = Sheets(ActiveSheet.Name).Cells(sat, 3).Value
If ARANAN1 = BULUNAN1 Then
Sheets(ActiveSheet.Name).Cells(sat, 3).Value = ""
End If
Next j
For i = 2 To sat1 - 1
ARANAN = Sheets(ActiveSheet.Name).Cells(i, 11).Value & Sheets(ActiveSheet.Name).Cells(i, 12).Value & Sheets(ActiveSheet.Name).Cells(i, 13).Value
BULUNAN = Sheets(ActiveSheet.Name).Cells(sat1, 11).Value & Sheets(ActiveSheet.Name).Cells(sat1, 12).Value & Sheets(ActiveSheet.Name).Cells(sat1, 13).Value
If ARANAN = BULUNAN Then
Sheets(ActiveSheet.Name).Cells(sat1, 11).Value = ""
Sheets(ActiveSheet.Name).Cells(sat1, 12).Value = ""
Sheets(ActiveSheet.Name).Cells(sat1, 13).Value = ""
End If
Next i
End Sub

 

[dragon44760]

Teşekkürler Hocam eline sağlık

 

[dragon44760]

Yazdığınız makro T.C.Kimlik numarasında birden fazla kimlik numarasını kopyalayıp yapıştırdığımızda sadece son satırı silmekte. C sütunu üzersinde yaptığımız işlemlerde diğer mükerrer girişleri teker teker silmekte. Ama ekte bulunan örnek dosya üzerindeki Kod ne kadar mükerrer girilmişse hepsini aynı anda silebilmekte.

Yine aynı durum
K sütununa "Ş.KODU"
L sütununa "HESAP NO"
M sütununa "HESAP UZANTISI"
sütunlarına girilen veriler içinde geçerli. Teker teker silmesin istiyorum. Mükerrer ne kadar veri varsa tek seferde silsin istiyorum. Bu üç sütuna girilen verilerde C sütunu dolu olma şartına da gerek yok.

Kodlarınızı buna göre revize ederseniz sevinirim...

 

[halit3]

Yazdığınız makro T.C.Kimlik numarasında birden fazla kimlik numarasını kopyalayıp yapıştırdığımızda sadece son satırı silmekte. C sütunu üzersinde yaptığımız işlemlerde diğer mükerrer girişleri teker teker silmekte. Ama ekte bulunan örnek dosya üzerindeki Kod ne kadar mükerrer girilmişse hepsini aynı anda silebilmekte.

Yine aynı durum
K sütununa "Ş.KODU"
L sütununa "HESAP NO"
M sütununa "HESAP UZANTISI"
sütunlarına girilen veriler içinde geçerli. Teker teker silmesin istiyorum. Mükerrer ne kadar veri varsa tek seferde silsin istiyorum. Bu üç sütuna girilen verilerde C sütunu dolu olma şartına da gerek yok.

Kodlarınızı buna göre revize ederseniz sevinirim...

P sütununda birleştirerek siliyor bir denermisiniz

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C:C,K:M")) Is Nothing Then Exit Sub
For i = [C65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("C2:C" & i), Cells(i, "C")) > 1 Then Cells(i, "C").ClearContents
Next
For sat = [K65536].End(3).Row To 2 Step -1
yer1 = Cells(sat, "K")
yer2 = Cells(sat, "L")
yer3 = Cells(sat, "M")
Cells(sat, "p").Value = yer1 & yer2 & yer3
Next
For j = [K65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("P2:P" & j), Cells(j, "P")) > 1 Then
Range(Cells(j, "k"), Cells(j, "m")).ClearContents
End If
Next
Columns("P:P").ClearContents
End Sub

 

[dragon44760]

Teşekkürler hocam bu sefer tam istediğim gibi

 

[seslemesaj]

excell 2007 a ve b sütünlarında numaralar var. b sütunundaki benzer numaralar a sütunundan nasıl çıkartılır. bi formülü varnıdır.

 

[Necdet]

excell 2007 a ve b sütünlarında numaralar var. b sütunundaki benzer numaralar a sütunundan nasıl çıkartılır. bi formülü varnıdır.

Merhaba,

Doğru anladıysam aşağıdaki kodları kullanabilirsiniz.

Sub Bul_ve_Sil()
Dim i          As Long
Dim Adet       As Integer
Dim SonSatir   As Long
SonSatir = [B65536].End(3).Row
For i = [A65536].End(3).Row To 1 Step -1
   If Application.WorksheetFunction.CountIf(Range("B1:B" & SonSatir), Cells(i, "A")) > 0 Then
      Range("A" & i).Delete Shift:=xlUp
      Adet = Adet + 1
   End If
Next i
Application.ScreenUpdating = True
If Adet > 0 Then
   MsgBox Adet & " Adet Çift Kayıt Bulunup Silinmiştir.."
Else
   MsgBox "Çift Kayıta Raslanmamıştır..."
End If
End Sub