• DİKKAT

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

Excel'de kelime seçme-ayırma..

Katılım
19 Mart 2012
Mesajlar
19
Excel Vers. ve Dili
2016
Merhabalar yaklasık 200.000 kelime arasindan L ile başlayıp L ile biten ve 6 haneli kelimeleri ayırıp B stünuna atmam veya diğerlerini silmem mümkünmüdür ?
 
Merhaba,

Örnek dosyayı kodları yazacak arkadaşa mı hazırlatmayı düşünüyorsunuz?
 
Kod:
Private Sub CommandButton1_Click()
Range("B:B").ClearContents
With Worksheets(1).Range("a1:a20000")
    b = 1
    Set c = .Find("l????l", LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            If Len(c.Value) = 6 Then
            Cells(b, "B").Value = c.Value
            b = b + 1
            End If
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
End Sub
 
Son düzenleme:
Merhaba,

Örnek dosyayı kodları yazacak arkadaşa mı hazırlatmayı düşünüyorsunuz?

Mümkünmü diye sorup varsada macro kodu istemistim sadece

Kod:
Private Sub CommandButton1_Click()
Range("B:B").ClearContents
With Worksheets(1).Range("a1:a20000")
    b = 1
    Set c = .Find("l????l", LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            If Len(c.Value) = 6 Then
            Cells(b, "B").Value = c.Value
            b = b + 1
            End If
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
End Sub

Teşekkürler fakat işe yaramadı malesef.
 
Merhaba,
Sn. suleyman242 nin örneğinde aşağıdaki kodu deneyin...

Kod:
Sub regex_test()

    Set reg = CreateObject("VBScript.RegExp")
    
    reg.ignorecase = True ' Büyük/Küçük harf duyarsız kabul et
    
    reg.Pattern = "l.{4}l"
    
    arr = [a1:a12].Value
    
    For i = 1 To UBound(arr, 1)
        If reg.test(arr(i, 1)) Then
            s = s + 1
            Cells(s, "b") = reg.Execute(arr(i, 1)).Item(0)
        End If
    Next

End Sub
 
Neden işe yaramadı ?
Benim örneğimde çalıştı ama.


Merhaba,
Sn. suleyman242 nin örneğinde aşağıdaki kodu deneyin...

Kod:
Sub regex_test()

    Set reg = CreateObject("VBScript.RegExp")
    
    reg.ignorecase = True ' Büyük/Küçük harf duyarsız kabul et
    
    reg.Pattern = "l.{4}l"
    
    arr = [a1:a12].Value
    
    For i = 1 To UBound(arr, 1)
        If reg.test(arr(i, 1)) Then
            s = s + 1
            Cells(s, "b") = reg.Execute(arr(i, 1)).Item(0)
        End If
    Next

End Sub

Aradığım buydu teşekkür ederim :)
 
Sn. Zeki Gürsoy, harfleri sayfanın herhangi bir hücresinden verdirebilirmi, örn.
reg.Pattern = "l.{4}l" yerine birinci harf c1 ,4 'ü d1, diğerharfi de e1 gibi.
 
Elbette olabilir. Yalnız şu var: Ortadaki 4 karakterin ne olduğu biliniyor ise "Instr" fonksyionu kullanılabilir. Bilinmiyor ise RegExp kitaplığı kullanmak faydalı olur.
 
Sn. Zeki Gürsoy, kullanılabilir dediğinin makrosu lazım, ne yaptımsa hücreden almasını beceremedim. Değerleri hücreden aldırabilirsek güzel bir kelime bulmaca ortaya çıkacak. İlgilenirseniz sevinirim. Saygılarımla.
 
Sn. Zeki Gürsay, bu şekilde kod çalışmadı maalesef, d1 deki rakam olayı görevini yapamıyor.
 
Son düzenleme:
Merhaba,

Zeki bey aradaki sembolleri yazacağınızı düşünerek kod önermiş. Sanırım siz direkt olarak değerleri yazıp denediniz.

Aşağıdaki gibi kullanabilirsiniz.

Kod:
reg.Pattern = CStr([C1] & ".{" & [D1] & "}" & [E1])
 
Merhaba,

Zeki bey aradaki sembolleri yazacağınızı düşünerek kod önermiş. Sanırım siz direkt olarak değerleri yazıp denediniz.

Aşağıdaki gibi kullanabilirsiniz.

Kod:
reg.Pattern = CStr([C1] & ".{" & [D1] & "}" & [E1])
Evet Korhan Hocam aradığım buydu, tırnakları denemiştim, ama nokta koymadığım için olmadığını anladım. Zeki hocama ve size çok teşekkür ederim.
 
Merhaba,
Sn. suleyman242 nin örneğinde aşağıdaki kodu deneyin...

Kod:
Sub regex_test()

    Set reg = CreateObject("VBScript.RegExp")
    
    reg.ignorecase = True ' Büyük/Küçük harf duyarsız kabul et
    
    reg.Pattern = "l.{4}l"
    
    arr = [a1:a12].Value
    
    For i = 1 To UBound(arr, 1)
        If reg.test(arr(i, 1)) Then
            s = s + 1
            Cells(s, "b") = reg.Execute(arr(i, 1)).Item(0)
        End If
    Next

End Sub

Zeki Hocam,
Kod:
reg.Pattern = "l[B][COLOR="Red"].[/COLOR][/B]{4}l"
Deki noktayı "." alayamadım?
 
"L" (küçük harf) ile başlayıp yine onunla bitecek, bu ikisi arasında 4 karakter uzunluğunda herhangi bir karakter (yani nokta ".") olacağı anlamına gelir.
 
Geri
Üst