Türkçe kelimelerin manalarındaki tekrarlar – 2

[VeliDemir]

Merhaba.

Benim Excel veritabanı dosyasındaki Türkçe kelimeler “A” sütunu içinde sırayla yer almaktadır. Her bir Türkçe kelime İngilizce manalarıyla birlikte aynı hücrede yer almakta olup, bir Türkçe kelimeden hemen sonra noktalı virgül işareti, ondan sonrada bu Türkçe kelimenin İngilizce manaları gelmektedir. Ayrıca, bu İngilizce manalar bazen bir kelimeden fazla olup, bu İngilizce manalar nokta işaretiyle başlayıp nokta işaretiyle bitmektedir.

Bir hücre içerisinde yer alan aynı Türkçe kelimeye ait İngilizce manalarından bir kısmı tekrar etmektedir. Bu nedenle, her bir hücrede yer alan İngilizce mana tekrarlarını ortadan kaldıran bir makro programını sizlerden rica ediyorum.

İyi Günler.

NOT: Makro programının çalışmasını gösteren örnek Excel dosyaları ekte yer almaktadır.

 

[halit3]

Merhaba.

Benim Excel veritabanı dosyasındaki Türkçe kelimeler “A” sütunu içinde sırayla yer almaktadır. Her bir Türkçe kelime İngilizce manalarıyla birlikte aynı hücrede yer almakta olup, bir Türkçe kelimeden hemen sonra noktalı virgül işareti, ondan sonrada bu Türkçe kelimenin İngilizce manaları gelmektedir. Ayrıca, bu İngilizce manalar bazen bir kelimeden fazla olup, bu İngilizce manalar nokta işaretiyle başlayıp nokta işaretiyle bitmektedir.

Bir hücre içerisinde yer alan aynı Türkçe kelimeye ait İngilizce manalarından bir kısmı tekrar etmektedir. Bu nedenle, her bir hücrede yer alan İngilizce mana tekrarlarını ortadan kaldıran bir makro programını sizlerden rica ediyorum.

İyi Günler.

NOT: Makro programının çalışmasını gösteren örnek Excel dosyaları ekte yer almaktadır.

Ekli dosyanızı inceleyin.

Option Explicit
Sub arama()
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=True, OtherChar:= _
".", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(20, 1)), TrailingMinusNumbers:=True
Dim x, r, s, i, say, deg
Application.ScreenUpdating = False
For r = 1 To Cells(Rows.Count, "a").End(3).Row
i = 0
deg = ""
say = Cells(r, Columns.Count).End(xlToLeft).Column
Set s = CreateObject("Scripting.Dictionary")
For Each x In Range(Cells(r, "a"), Cells(r, say))
If x.Value <> "" Then
If Not s.exists(Trim(x.Value)) Then
s.Add Trim(x.Value), Nothing
i = i + 1
If i = 1 Then
deg = x.Value & ";"
Else
deg = deg & x.Value & "."
End If
End If
End If
Next x
Cells(r, "a").Value = deg
Next r
Columns("B:ıv").ClearContents
Application.ScreenUpdating = True
MsgBox "işlem tamam"
End Sub

not: naktadan sonraki boşluklar aynı olmadığı için kelimeler aynen alınmıştır.

 

[VeliDemir]

Ufak bir rica

Merhaba, öncellikle bu yardımınızdan ötürü Halit bey size çok teşekkür ederim.
Sizlerden ufak bir ricam daha olacak:

Excel dosyasının "A" sütununun aynı hücrelerinde yer alıp aralarında noktalı virgül işareti olan aynı kelimeleri, bu excel dosyasının "C" sütuna yazan bir makro programını yapabilir misiniz?

İyi günler.

NOT: Bu programın çalışmasını gösteren Excel dosyaları ekte yer almaktadır.

 

[halit3]

Merhaba, öncellikle bu yardımınızdan ötürü Halit bey size çok teşekkür ederim.
Sizlerden ufak bir ricam daha olacak:

Excel dosyasının "A" sütununun aynı hücrelerinde yer alıp aralarında noktalı virgül işareti olan aynı kelimeleri, bu excel dosyasının "C" sütuna yazan bir makro programını yapabilir misiniz?

İyi günler.

NOT: Bu programın çalışmasını gösteren Excel dosyaları ekte yer almaktadır.

Bu tür örneklerinizde iki tane örnek dosya eklemenize gerek yok
örneklerinizi başka sayfada veya başka bir hücrede gösterebilirsiniz.

kod

Sub deneme()
sat = 1
For r = 1 To Cells(Rows.Count, "a").End(3).Row
aranan1 = Cells(r, "a").Value
For i = 1 To Len(aranan1)
If Mid(aranan1, i, 1) = ";" Then
If Mid(aranan1, i - 1, 1) = Mid(aranan1, i + 1, 1) Then
Cells(sat, "c").Value = Mid(aranan1, i + 1, 1)
sat = sat + 1
End If
End If
Next i
Next r
End Sub

 

[VeliDemir]

Programdaki hata

Merhaba bu programı bir Excel veritabanı dosyasında denedim, ancak program hata verdi. Bu programdaki hatayı düzeltebilir misiniz?

İyi günler.

NOT: Bu Excel dosyası ekte yer almaktadır.

 

[halit3]

Merhaba bu programı bir Excel veritabanı dosyasında denedim, ancak program hata verdi. Bu programdaki hatayı düzeltebilir misiniz?

İyi günler.

NOT: Bu Excel dosyası ekte yer almaktadır.

3 nolu mesajınızdaki örnek dosyanıza 4 nolu mesajımdaki kodu hazırlamıştım denedinizmi olmadımı ben deniyorum oluyor.

diğer tarafdan alıntı yazımdada yazıyor örnek dosyanız bire bir aynı olmalı oysa 5 nolu mesajınızdaki dosya ile 3 nolu mesajınızdaki dosya tamamen farklı

 

[VeliDemir]

örneğin yetersizliği

Merhaba, Halit bey. En son mesajımdaki ek dosya, sorunumu en gercekçi olarak gösterdiğinden ötürü onu ek olarak koyma ihtiyacı hissettim. Lütfen kusuruma bakmayınız. İyi günler.

 

[VeliDemir]

Özür

Merhaba, Ben istediğim şeyi sizlere iyi bir şekilde iletemediğimden ötürü çok pişmanım ve önceden yaptığım hatadan ötürü sizlerden çok özür diliyorum.


Bir excel dosyasının "A" sütunundaki hücrelerde İngilizce kelimelerden hemen sonra gelen noktalı virgül işareti ve noktalı virgül işaretinden sonra ise o İngilizce kelimelerin Türkçe anlamları yer almaktadır ve her Türkçe anlamdan sonra nokta işareti gelmektedir.

İngilizce kelimelerden bazılarının aynı yazılışa sahip Türkçe anlamları bulunmaktadır. Bundan ötürü, benim sizden acizane ricam: söz konusu İngilizce kelimeleri bulan ve bu Excel dosyasının "C" sütununa yazan bir makro programını yapmanız olacaktır.

İyi günler.

NOT: Bu programın çalışmasına ilişkin örnek dosya ektedir.