2kolonlu bir satırın tersi başka satırda varsa nasıl bulunur?

[drglacier]

Sorunum şu: diyelim 3 satır, 2 kolonlu bir data var elimde.

A B
B C
B A

ben istiyorum ki A B ve B A olan kolonları bana bir şekilde belli etsin (silsin, bir diğer kolonda böyle olan satırların yanına bir sayı koysun vs) çünkü bu datalar benim için tekrar edilmiş çift veriler oluyor.

Ama bunu tabi ki A ve B'den bağımsız bir şekilde yapsın. Yani elimde 6000 satırlık data var. bana bunu yapabilecek basit bir formül lazım
Yapmak istediğim algoritma:
1. satırın 1. kolonundakini 2. kolonda arasın. Bulduğu satırın 1 kolonuna baksın. Eğer 1.satır 2. kolondakiyle aynıysa bana bildirsin.
EĞER komutuyla uğraştım ama bir türlü işin içinden çıkamadım çünkü o komutu da bu siteden yeni öğrendim.

Bunun basit bir yolu var mı acaba??

Tezim için lazım dataların içinde kayboldum yardım edin lütfen

 

[uzmanamele]

merhaba

buraya bakınız

tık tık tık...

 

[drglacier]

merhaba

buraya bakınız

tık tık tık...

merhabalar, oraya zaten baktım, dosyayı da indirdim ama benim istediğim tarz bir mükerrer kayıt örneği bulamadım. Ya da vardı da ben anlayamadım bilmiyorum. O dosyada hangisi benimkine uyuyor acaba????

 

[Ergün Güler]

Sorunum şu: diyelim 3 satır, 2 kolonlu bir data var elimde.

A B
B C
B A

ben istiyorum ki A B ve B A olan kolonları bana bir şekilde belli etsin (silsin, bir diğer kolonda böyle olan satırların yanına bir sayı koysun vs) çünkü bu datalar benim için tekrar edilmiş çift veriler oluyor.

Ama bunu tabi ki A ve B'den bağımsız bir şekilde yapsın. Yani elimde 6000 satırlık data var. bana bunu yapabilecek basit bir formül lazım
Yapmak istediğim algoritma:
1. satırın 1. kolonundakini 2. kolonda arasın. Bulduğu satırın 1 kolonuna baksın. Eğer 1.satır 2. kolondakiyle aynıysa bana bildirsin.
EĞER komutuyla uğraştım ama bir türlü işin içinden çıkamadım çünkü o komutu da bu siteden yeni öğrendim.

Bunun basit bir yolu var mı acaba??

Tezim için lazım dataların içinde kayboldum yardım edin lütfen

Sayın drglacier,
Sorunuzu anladık. Çözümü de buluruz Ancak sorunuzda bazı eksiklikler var.
Mesela,
A B
B A (bu bir mükerrerdir)

A A
A A (size göre mükerrer midir?)


A ...
... A (size göre mükerrer midir?)

2.olarak mükerrelere X işareti koyduğumuzu düşünürsek

A B
B A x (sadece birinci mükerrere mi konulacak?)

yoksa her ikisine mi?

A B x
B A x

veya aşağıdaki gibi mi?

A B
B A x
B A x
B A x
B A x


Bunları cevaplayınız ve bir de dosyanızı ekleyiniz.

İyi çalışmalar.

 

[Necdet]

Merhaba,

Kodları bir deneyiniz.

Sub Karsilastir()
Dim i    As Long
Dim c    As Range
Dim Addr As String
Application.ScreenUpdating = False
Range("c:c").ClearContents
For i = 1 To [A65536].End(3).Row
   With Range("B:B")
       Set c = .Find(Cells(i, "A"), LookIn:=xlValues, LookAt:=xlWhole)
       If Not c Is Nothing Then
           Addr = c.Address
           Do
               If Cells(c.Row, "A") = Cells(i, "B") Then Cells(c.Row, "C") = "Benzer"
               Set c = .FindNext(c)
           Loop While Not c Is Nothing And c.Address <> Addr
       End If
   End With
Next i

For i = 2 To [A65536].End(3).Row
   With Range("A:A")
       Set c = .Find(Cells(i, "A"), LookIn:=xlValues, LookAt:=xlWhole)
       If Not c Is Nothing Then
           Addr = c.Address
           Do
           If c.Row <> i And Cells(i, "B") = Cells(c.Row, "B") Then Cells(c.Row, "C") = "Benzer"
               Set c = .FindNext(c)
           Loop While Not c Is Nothing And c.Address <> Addr
       End If
   End With
Next i
Application.ScreenUpdating = True
End Sub

 

[drglacier]

Necdet Bey çok teşekkürler. Kodu denedim. İstediğim şeyleri yapıyor.
Peki ek birşey istesem, programa nasıl dahil edilebilir? Çünkü bu noktada da problemim olduğunu fark ettim.

Sorumu Ergün Bey'in sordukları üzerinden sorayım. Aşağıda cevapladığım şeylere göre bu mükerrer satırları datamdan yok etmek istesem? yani bana ayrı bir kolonda silinmiş, tekrarsız halleriyle verme şansı olabilir mi programın? Çünkü sizin yolladığınız kodu uyguladığımda kimin benzeri nerde diye onu bulup data listesinde silmem gerektiğini farkettim. Sadece belirlemek yetmiyormuş malesef

Mesela,
A B
B A (bu bir mükerrerdir) Evet

A A
A A (size göre mükerrer midir?) Evet


A ...
... A (size göre mükerrer midir?) Hayır. A'nın karşısına gelenler farklı olduğu sürece problem yok. 2 farklı protein etkileşiyorsa, yönü önemli değil.

2.olarak mükerrelere X işareti koyduğumuzu düşünürsek

A B
B A x (sadece birinci mükerrere mi konulacak?)

yoksa her ikisine mi?

A B x
B A x

veya aşağıdaki gibi mi? Aynen bu şekilde

A B
B A x
B A x
B A x
B A x

 

[drglacier]

bu arada ekte dosyamı da gönderiyorum. Elimdeki datalar buna benzer datalar.

Tekrardan yardımlarınız için teşekkürler.

 

[Necdet]

Merhaba,

Sorunuzu tam anlamamakla birlikte, benzer satırlardan birinin kalması ve diğerlerinin silinmesini istiyorsanız aşağıdaki kodları deneyiniz.

Sub Karsilastir()
Dim i    As Long
Dim SonS As Long
Dim c    As Range
Dim Addr As String
Application.ScreenUpdating = False
Range("E:F").ClearContents
SonS = [A65536].End(3).Row
For i = 2 To SonS
   With Range("B1:B" & i - 1)
       Set c = .Find(Cells(i, "A"), LookIn:=xlValues, LookAt:=xlWhole)
       If Not c Is Nothing Then
           Addr = c.Address
           Do
               If Cells(c.Row, "A") = Cells(i, "B") Then Cells(c.Row, "C") = "Benzer"
               Set c = .FindNext(c)
           Loop While Not c Is Nothing And c.Address <> Addr
       End If
   End With
Next i
For i = 2 To SonS
   With Range("A1:A" & i - 1)
       Set c = .Find(Cells(i, "A"), LookIn:=xlValues, LookAt:=xlWhole)
       If Not c Is Nothing Then
           Addr = c.Address
           Do
           If c.Row <> i And Cells(i, "B") = Cells(c.Row, "B") Then Cells(c.Row, "C") = "Benzer"
               Set c = .FindNext(c)
           Loop While Not c Is Nothing And c.Address <> Addr
       End If
   End With
Next i
ActiveSheet.Range("A1:C11" & SonS).AutoFilter Field:=3, Criteria1:="="
Columns("A:B").Select
Selection.Copy
Range("E1").Select
ActiveSheet.Paste
Selection.AutoFilter
Range("C:C").ClearContents
Range("G1").Select
Application.ScreenUpdating = True
End Sub

 

[Ergün Güler]

bu arada ekte dosyamı da gönderiyorum. Elimdeki datalar buna benzer datalar.

Tekrardan yardımlarınız için teşekkürler.

Sayın drglacier,

Dosyanız ektedir. Fonksiyonlar ile hazırlanmıştır. İnceleyiniz.
İyi çalışmalar