Kelime listeleme dosyamdaki hatalar

[Haluk]

2002 versiyonunda durum nedir?

.

 

[Korhan Ayhan]

Ben TXT içindeki verilerin tümünü seçip kopyala-yapıştır yaptığımda aşağıdaki durum oluşuyor.

 

[izcik]

2002 versiyonunda durum nedir?

.

İki kod da , 2002 de eksik listeliyor uzmanım. Ama 2007 de sorun yok uzmanım

 

[Korhan Ayhan]

@izcik sizde durum benim eklediğim görselde ki gibi mi oluyor?

 

[izcik]

Uz

@izcik sizde durum benim eklediğim görselde ki gibi mi oluyor?

Uzmanım ne yazık ki resmi indiremedim.

Ama şöyle özetleyebilirim. Haluk ve Yusuf uzmanlarımın kodları, 2007 de çalıştı. 2002 de çalışmadı (daha doğrusu eksik listeleme yapıyorlar).

Yine de B sütununa yapıştırdığımız bir metindeki bütün kelimeleri, eksiksiz bir şekilde A sütununa listeleyen başka kodlar da olursa, severek denemek isterim.
Yarın daha sakince inceleyeceğim uzmanlarımın kodlarını.

Özellikle benim gibi yazmaya meraklı insanların yazdıklarını kontrol etme açısından son derece faydalı bir excel dosyası olacak.

 

[Korhan Ayhan]

Şöyle yapın. İlk mesajda paylaştığınız TXT dosyasındaki verileri B1 hücresi üzerine yapıştırıp oluşan görseli paylaşın.

Bende oluşan görsel ektedir.

1588108058985.png

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

 

[izcik]

Şöyle yapın. İlk mesajda paylaştığınız TXT dosyasındaki verileri B1 hücresi üzerine yapıştırıp oluşan görseli paylaşın.

Bende oluşan görsel ektedir.

Ekran_Alintisi.jpg dosyasını indir - download

Ekran_Alintisi.jpg dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

www.dosya.tc

Uzmanım ekran görüntüsü şu şekildedir (2007)

 

[Korhan Ayhan]

Eklediğiniz resim #4 numaralı mesajınızdaki ifade ile sanki örtüşmüyor gibi...

 

[YUSUF44]

Yusuf uzmanım emeğinize sağlık, eğer size zahmet olmazsa “yinelenenleri kaldırma“ özelliği içermeyen kodları da oluşturabilir misiniz?

ensonA olan iki satır yinelenenleri kaldırmak içindir. O satırları silebilirsiniz. RemoveDuplicates olan satır bu işlemi tapan satırdır.

 

[izcik]

Eklediğiniz resim #4 numaralı mesajınızdaki ifade ile sanki örtüşmüyor gibi...

Uzmanım o kadar çok denemeler yaptım ki kafa karıştı iyice. Bugün sakince hepsini baştan deneyeceğim ????

 

[izcik]

ensonA olan iki satır yinelenenleri kaldırmak içindir. O satırları silebilirsiniz. RemoveDuplicates olan satır bu işlemi tapan satırdır.

Uzmanım hepsini deneyeceğim. Yapamazsam sizi rahatsız ederim ????

 

[izcik]

Eklediğiniz resim #4 numaralı mesajınızdaki ifade ile sanki örtüşmüyor gibi...

Sayın uzmanım, o durum bende de bir kere oldu. Exceli kapatıp açınca bir daha olmadı. İlginç bir kopyala yapıştır şekli olmuş oldu. Keşke her zaman yapabilsek böyle değişik yapıştırmalar ????

Bir çalışma yaptım, şimdi aktarıyorum

 

[izcik]

Sayın Haluk uzmanımın ve Sayın Yusuf44 uzmanlarımın vermiş olduğu kodların (1. ve 2. kodlar) hepsiyle defalarca deneme yanılmalar yaptım.

Bir excel sayfasına neticeleri listeledim.

UZMANLARIMIN_KODLARI_VE_DENEMELERIM.xls dosyasını indir - download

UZMANLARIMIN_KODLARI_VE_DENEMELERIM.xls dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

www.dosya.tc

 

[Korhan Ayhan]

Alternatif olarak deneyiniz.

Option Explicit

Sub Kelimeleri_Listele()
    Dim Veri As Variant, Son As Long, X As Long, Y As Long
    Dim Say As Long, Kelime As Variant, Zaman As Double
    Dim Noktalama_Isaretleri As Variant
   
    Zaman = Timer
   
    Son = Cells(Rows.Count, 2).End(3).Row
    If Son = 1 Then Son = 2
   
    Veri = Range("B1:B" & Son).Value
   
    Noktalama_Isaretleri = Array("...", ".", ",", ":", ";", "!", "?", """", "(", ")", "-", "—", "/", Chr(10))

    Range("A:A").Clear
   
    ReDim Liste(1 To Rows.Count, 1 To 1)
   
    Say = 1
   
    Liste(Say, 1) = "KELİMELER"
   
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 1) <> "" Then
            Kelime = Veri(X, 1)
           
            For Y = LBound(Noktalama_Isaretleri) To UBound(Noktalama_Isaretleri)
                Kelime = Replace(Kelime, Noktalama_Isaretleri(Y), " ")
            Next
           
            Kelime = Split(Kelime, " ")
           
            For Y = LBound(Kelime) To UBound(Kelime)
                If Kelime(Y) <> "" Then
                    Say = Say + 1
                    Liste(Say, 1) = Kelime(Y)
                End If
            Next
        End If
    Next
   
    If Say > 0 Then
        Range("A1").Font.Bold = True
        Range("A1").Resize(Say) = Liste
        Range("A:A").EntireColumn.AutoFit
    End If
   
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[izcik]

Alternatif olarak deneyiniz.

Option Explicit

Sub Kelimeleri_Listele()
    Dim Veri As Variant, Son As Long, X As Long, Y As Long
    Dim Say As Long, Kelime As Variant, Zaman As Double
    Dim Noktalama_Isaretleri As Variant
 
    Zaman = Timer
 
    Son = Cells(Rows.Count, 2).End(3).Row
    If Son = 1 Then Son = 2
 
    Veri = Range("B1:B" & Son).Value
 
    Noktalama_Isaretleri = Array("...", ".", ",", ":", ";", "!", "?", """", "(", ")", "-", "—", "/", Chr(10))

    Range("A:A").Clear
 
    ReDim Liste(1 To Rows.Count, 1 To 1)
 
    Say = 1
 
    Liste(Say, 1) = "KELİMELER"
 
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 1) <> "" Then
            Kelime = Veri(X, 1)
         
            For Y = LBound(Noktalama_Isaretleri) To UBound(Noktalama_Isaretleri)
                Kelime = Replace(Kelime, Noktalama_Isaretleri(Y), " ")
            Next
         
            Kelime = Split(Kelime, " ")
         
            For Y = LBound(Kelime) To UBound(Kelime)
                If Kelime(Y) <> "" Then
                    Say = Say + 1
                    Liste(Say, 1) = Kelime(Y)
                End If
            Next
        End If
    Next
 
    If Say > 0 Then
        Range("A1").Font.Bold = True
        Range("A1").Resize(Say) = Liste
        Range("A:A").EntireColumn.AutoFit
    End If
 
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

Sayın Korhan uzmanım
Bu kodlar da kusursuz çalışıyor
Teşekkür ederim. Sağolunuz bütün emekleriniz için.

 

[Haluk]

Excel 2002 herhalde "Regular Expressions" destekliyordur..... aşağıdakini de deneyebilirsiniz;

Sub Test()
'   Haluk - 29/04/2020
'   sa4truss@gmail.com
    Dim regExp As Object, i As Integer
    Dim objMatches As Object
   
    Range("A2:A" & Rows.Count) = ""
   
    Set regExp = CreateObject("VBScript.RegExp")
    With regExp
      .IgnoreCase = True
      .Global = True
      .Pattern = "([^\s\.\,\(\)\?\!\r\-]+)"
    End With
   
    Set objMatches = regExp.Execute(Range("B1").Text)
    For i = 0 To objMatches.Count - 1
        Range("A" & i + 2) = objMatches(i).SubMatches(0)
    Next
End Sub

.