• DİKKAT

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

Cümle içerisinde belirli bölümü silme

ASLAN7410

ASLAN7410

Katılım
15 Temmuz 2012
Mesajlar
2,802
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
Merhaba hayırlı akşamlar.

Ekte gönderdiğim excel dosyamın F sütununda sistemden aldığımız
aşağıdaki gibi bilgiler var, bazı hücrelerde bir satır, bazı hücrelerde birden çok satır var.

[00:15,13.8.2017] +90555 555 55 55: Ali Veli
[00:15,13.8.2017] +90555 555 55 55: Ali Veli
[00:15,13.8.2017] +90555 555 55 55: Ali Veli
[00:15,13.8.2017] +90555 555 55 55: Ali Veli

Benim yapmak istediğim : (baş taraftan iki nokta kısma kadar silmek istiyorum.)

Yani sadece yazıların kalmasını istiyorum. Yardımcı olur musunuz?
.
 

Ekli dosyalar

ASLAN7410' Alıntı:
Merhaba hayırlı akşamlar.

Ekte gönderdiğim excel dosyamın F sütununda sistemden aldığımız
aşağıdaki gibi bilgiler var, bazı hücrelerde bir satır, bazı hücrelerde birden çok satır var.

[00:15,13.8.2017] +90555 555 55 55: Ali Veli
[00:15,13.8.2017] +90555 555 55 55: Ali Veli
[00:15,13.8.2017] +90555 555 55 55: Ali Veli
[00:15,13.8.2017] +90555 555 55 55: Ali Veli

Benim yapmak istediğim : (baş taraftan iki nokta kısma kadar silmek istiyorum.)

Yani sadece yazıların kalmasını istiyorum. Yardımcı olur musunuz?
.
Genişletmek için tıkla ...

Örnek yetersiz; var olan örnek için aşağıdaki şekilde deneyiniz.
Sonuç kolonunu seçip, Giriş bölümünden Metni Kaydır Yapın.

Kod: 
=YERİNEKOY(F2;PARÇAAL(F2;1;BUL(": ";F2;1));DAMGA(13))
 
Son düzenleme:
Sayın Asri Bey, ilginiz için çok teşekkür ederim.

Yapmak istediğim şekli ekte gönderiyorum.
 

Ekli dosyalar

  • Ekran Alıntısı.JPG
    Ekran Alıntısı.JPG
    49.2 KB · Görüntüleme: 5
Aşağıdaki kodları bir modüle yapıştırıp deneyin.
Kod: 
Sub askm_Kelime_Böl()
Dim SonSatir As Long
SonSatir = Range("F" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 2 To SonSatir
    Kelime = Split(Cells(i, "F"), ":")(2)
    Cells(i, "G") = Split(Kelime, vbLf)(0)
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "İşlem tamamlandır...", vbInformation, "ASKM"
End Sub
 
Sayın askm ilginiz için teşekkür ediyorum.

Kodlar güzel çalışıyor, ancak hücre içerisindeki Ali Veli cümlesini teke düşürüyor, ben buraya Ali Veli yazdım, ancak burada her bir cümle farklı şekilde.
 
Sayın Asri Bey, bu formülle yapılan işlemi sütun için koda çevirebilir misiniz?

Veri çok olduğu kilitleniyor.
 
Sayın Asri Bey dediğiniz gibi hazırladım, örnek dosyayı gönderiyorum.

Cümleler internetten alıntıdır.
 

Ekli dosyalar

ASLAN7410' Alıntı:
Sayın Asri Bey dediğiniz gibi hazırladım, örnek dosyayı gönderiyorum.

Cümleler internetten alıntıdır.
Genişletmek için tıkla ...

Kod Alternatif; Farklı kolonda sonuç için.

Kod: 
Sub veri_temizle()
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   Columns("F:F").Select
   Selection.Copy
   Columns("G:G").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   Application.CutCopyMode = False
   Range("G1").Select
    
   sonsatir = Cells(Rows.Count, "A").End(3).Row
   For i = 2 To sonsatir
    veri = Cells(i, "G").Value
    parca = Left(veri, InStr(veri, ": ") + 1)
    Cells(i, "G").Value = Replace(veri, parca, Chr(13))
   Next i
   
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
   
   Columns("G:G").Select
   With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
   End With
    Range("G2").Select
End Sub

Kod Alternatif; Aynı kolonda sonuç için

Kod: 
Sub veri_temizle()
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   sonsatir = Cells(Rows.Count, "A").End(3).Row
   For i = 2 To sonsatir
    veri = Cells(i, "F").Value
    parca = Left(veri, InStr(veri, ": ") + 1)
    Cells(i, "F").Value = Replace(veri, parca, Chr(13))
   Next i
   
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
   
   Columns("F:F").Select
   With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
   End With
    Range("G2").Select
End Sub
 
Sayın Asri Bey kodlar tam istediğim gibi çalışıyor, ellerinize sağlık çok teşekkür ederim.

Hayırlı çalışmalar, hayırlı geceler diliyorum.
 
Alternatif;

Deneyiniz.

Kod: 
Option Explicit

Sub Verileri_Duzenle()
    Dim X As Long, Son As Long, Y As Integer, Say As Long, Z As Integer
    Dim Cumle As Variant, Kelime As Variant, Kontrol As Boolean
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Son = Cells(Rows.Count, 1).End(3).Row
    
    For X = 2 To Son
        ReDim Liste(0 To 0)
        Say = 0
        If InStr(1, Cells(X, "F"), Chr(10)) > 0 Then
            Cumle = Split(Cells(X, "F"), Chr(10))
            For Y = 0 To UBound(Cumle)
                If InStr(1, Cumle(Y), ": ") > 0 Then
                    For Z = 0 To 9
                        If InStr(1, Cumle(Y), Z & ": ") > 0 Then
                            Kelime = Split(Cumle(Y), Z & ": ")
                            Kontrol = True
                            Exit For
                        End If
                    Next
                    If Kontrol = True Then
                        Kontrol = False
                        ReDim Preserve Liste(0 To Say)
                        Liste(Say) = Kelime(UBound(Kelime))
                        Say = Say + 1
                    End If
                End If
            Next
            If UBound(Liste()) > 0 Then Cells(X, "F") = Join(Liste, Chr(10))
            Erase Liste
        Else
            For Z = 0 To 9
                If InStr(1, Cells(X, "F"), Z & ": ") > 0 Then
                    Kelime = Split(Cells(X, "F"), Z & ": ")
                    Kontrol = True
                    Exit For
                End If
            Next
            If Kontrol = True Then
                Kontrol = False
                Cells(X, "F") = Kelime(UBound(Kelime))
            End If
            Kelime = Empty
        End If
    Next
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Sayın Korhan Bey alternatif kod için çok teşekkür ederim ellerinize sağlık. Kodlar gayet güzel çalışıyor.

İşlem bittikten sonra cümle başlarında hep bir boşluk kalıyor.
 
Küçük düzeltmeler yaptım. Tekrar deneyiniz.
 
Sayın Korhan Bey çok teşekkür ederim, tam istediğim gibi oldu.

Hayırlı geceler, hayırlı çalışmalar.
 
Bir alternatif de benden:
Kod: 
Sub verileri_duzenle_antonio()
Dim sh As Worksheet, ss As Long, p As Object, q As Object, veri As String
    Set sh = Sayfa1
    ss = sh.Range("F" & Rows.Count).End(3).Row
    Set p = CreateObject("VBScript.RegExp")
    With p
        .Global = True
        .MultiLine = True
        .Pattern = "[A-Za-zçÇıİğĞöÖşŞüÜ].+\??\n?"
    End With
    For i = 2 To ss
        If p.test(sh.Range("F" & i)) Then
            Set q = p.Execute(sh.Range("F" & i))
            For d = 0 To q.Count - 1
                veri = veri & q(d)
            Next d
                sh.Range("G" & i).Value = veri
            veri = vbNullString
        End If
    Next i
    MsgBox "İşlem tamamlandı.", vbInformation, "KELİME AYIKLAMA RAPORU"
End Sub
 
Son düzenleme:
Sayın antonio, size de çok teşekkür ediyorum. Hayırlı geceler, hayırlı çalışmalar dilerim.
 
#12 nolu mesajımda ki kodda küçük bir düzeltme daha yaptım. Son halini deneyiniz.

Eklediğiniz dosyada 8. satırdaki veride "Para: " ifadesi sorun yaratmıştı. Bunun önüne geçecek sorgular eklenmiştir.
 
Sayın Korhan Bey bu dediğiniz konu dikkatimden kaçmış.

Başka kelimelere ":" (iki nokta üst üstüste) koyup kodu çalıştırdığımda, koymuş olduğum ":" noktalar siliniyor, sadece "Para:" kısmını düzgün atıyor. Bilginiz olsun.
 
Korhan Bey tamamdır, çok teşekkür ederim.
Tam istediğim gibi çalışıyor. ":" noktaları yanlış yere koyup kodu çalıştırmışım.

Hayırlı geceler, hayırlı çalışmalar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst