• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kelime listeleme dosyamdaki hatalar

  • Konbuyu başlatan Konbuyu başlatan izcik
  • Başlangıç tarihi Başlangıç tarihi
2002 versiyonunda durum nedir?

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

217207
 
@izcik sizde durum benim eklediğim görselde ki gibi mi oluyor?
 
Uz
Korhan Ayhan' Alıntı:
@izcik sizde durum benim eklediğim görselde ki gibi mi oluyor?
Genişletmek için tıkla ...

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.
 
Şö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.

we.tl

1588108058985.png

1 file sent via WeTransfer, the simplest way to send your files around the world
we.tl we.tl
 
Eklediğiniz resim #4 numaralı mesajınızdaki ifade ile sanki örtüşmüyor gibi...
 
izcik' Alıntı:
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?
Genişletmek için tıkla ...

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.
 
Korhan Ayhan' Alıntı:
Eklediğiniz resim #4 numaralı mesajınızdaki ifade ile sanki örtüşmüyor gibi...
Genişletmek için tıkla ...
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
 
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 www.dosya.tc
 
Alternatif olarak deneyiniz.

C++: 
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
 
Korhan Ayhan' Alıntı:
Alternatif olarak deneyiniz.

C++: 
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
Genişletmek için tıkla ...
Sayın Korhan uzmanım
Bu kodlar da kusursuz çalışıyor
Teşekkür ederim. Sağolunuz bütün emekleriniz için.
 
Excel 2002 herhalde "Regular Expressions" destekliyordur..... aşağıdakini de deneyebilirsiniz;

Kod: 
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


.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst