hÜCRE İÇERİĞİNİ KARŞILAŞTIRMA (Olanlar - Olmayanlar)

[QNURi]

Merhaba sevgili arkadaşlar,
Yeni bir iş üzerinde çalışıyorum. Fakat ne yaptıysam başaramadım. Örnekle anlatayım. (Ekte dosya var)

Ben seyahati seven birisiyim. Sık sık seyahat ederim. Gitmeyi planladığım ülkelerin 2 karakterli ülke kodları var.(US, DE gibi)

Bu güne kadar gittiğim ülkelerin kodları bir hücrede yazılı. [US DE]
Tüm ülkeler de yanındaki hücrede yazılı. [ DE IT GB US JP]
Bir sonraki hücrede ise henüz gitmediğim ülke kodlarının çıkmasını istiyorum.[IT GB JP]

Ekli dosyayı incelerseniz hemen anlarsınız. Yeni başlayanlar kısmında yazdım bir haftadır çözemedik. Çok zor gibi duruyor. Çözene şimdiden helal olsun.

Hayırlı ramazanlar,
ONUR

 

[akat]

gidilen ülkelerin kodları sıralı biçimde sutunlara yerleştirilir. Tüm ülke kodlarıda sıralı olarak yerleştirilir. İki sütunda sıralanarak satırlar eşlenir. Eşlenen satırlar doğal olarak gidilen ülkeler olur. Boş kalan satırlarda gidilecek ülkelere kalır.

 

[Orion1]

Dosyanız ekte.

Sub ulkeler()
Dim deg, ulkeler, sat As Long, i As Long, deg2 As String, k As Integer
sat = 6
Sheets("Sayfa1").Select
Range("F6:F65536").ClearContents
    deg2 = Range("D6").Value

For i = 6 To Cells(65536, "B").End(xlUp).Row
    If Cells(i, "B").Value <> "" Then
        deg = Split(Cells(i, "B").Value, " ")
        For k = LBound(deg) To UBound(deg)
            deg2 = Replace(deg2, deg(k), "")
        Next k
        Cells(sat, "F").Value = Trim(deg2)
        sat = sat + 2
    End If
Next i
MsgBox "İşlem tamamdır.", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[QNURi]

Evren Bey,
Çok iyi bir çalışma olmuş. Fakat Sağ taraftaki hücrelerde eksik ülke kodları kalıyor. Sanıyorum siz sağdaki hücrelerdende çıkarttınız. İsteğim şu,

Örn.1 => [US, DE, GB] (eksi) [DE] = [US, GB]
Örn.2 => [US, DE, GB] (eksi) [GB DE] = [US]

Siz bir adım ötesini yapmışsınız. Helal olsun. Bunu yaparsanız size minnetar kalırım.

Onur

 

[Orion1]

Evren Bey,
Çok iyi bir çalışma olmuş. Fakat Sağ taraftaki hücrelerde eksik ülke kodları kalıyor. Sanıyorum siz sağdaki hücrelerdende çıkarttınız. İsteğim şu,

Örn.1 => [US, DE, GB] (eksi) [DE] = [US, GB]
Örn.2 => [US, DE, GB] (eksi) [GB DE] = [US]

Siz bir adım ötesini yapmışsınız. Helal olsun. Bunu yaparsanız size minnetar kalırım.

Onur

Böylemi istiyorsunuz?

Sub ulkeler()
Dim deg, ulkeler, sat As Long, i As Long, deg2 As String, k As Integer
sat = 6
Sheets("Sayfa1").Select
Range("F6:F65536").ClearContents
For i = 6 To Cells(65536, "B").End(xlUp).Row
    If Cells(i, "B").Value <> "" Then
        deg2 = Range("D6").Value
        deg = Split(Cells(i, "B").Value, " ")
        For k = LBound(deg) To UBound(deg)
            deg2 = Replace(deg2, deg(k), "")
            deg2 = Replace(deg2, "  ", " ")
        Next k
        Cells(sat, "F").Value = Trim(deg2)
        sat = sat + 2
    End If
Next i
MsgBox "İşlem tamamdır.", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[QNURi]

Çok teşekkür ediyorum. Sağolun. Tam istediğim gibi olmuş.
Sizlere inanamıyorum. Mükemmelsiniz.

Onur

 

[Orion1]

Çok teşekkür ediyorum. Sağolun. Tam istediğim gibi olmuş.
Sizlere inanamıyorum. Mükemmelsiniz.

Onur

Rica ederim.
O sizin mükemmelliğiniz.

 

[QNURi]

Rica ederim.
O sizin mükemmelliğiniz.

Çok küçük bir eklemeye ihtiyaç kaldı. O da sonuçların yazdığı satırda silinen karakterlerin yeri boş kalıyor. Sonuç verilen hücrede karakterler arasında bir boşluk kalacak şekilde düzeltebilirsek süper olur.

Örn [US____DE_GB] => [US_DE_GB] olmalı

 

[Orion1]

Çok küçük bir eklemeye ihtiyaç kaldı. O da sonuçların yazdığı satırda silinen karakterlerin yeri boş kalıyor. Sonuç verilen hücrede karakterler arasında bir boşluk kalacak şekilde düzeltebilirsek süper olur.

Örn [US____DE_GB] => [US_DE_GB] olmalı

Dosyayı önceki indirdiğiniz yerden tekrar indirin.Dediğiniz yaptım.

 

[QNURi]

Çok teşekkür ederim. Şimdi %100 tamamdır.

Onur.

 

[Orion1]

Çok teşekkür ederim. Şimdi %100 tamamdır.

Onur.

Rica ederim.
İyi çalışmalar.