• DİKKAT

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

hücrede bulunan köşeli parantez içerisindeki

T

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,181
Excel Vers. ve Dili
Ofis 2019 Türkçe
Ekli dosyada göndermiş olduğum; A sutununda bulunan hücrelerdeki köşeli parantez içerisinde bulunan kelimeyi parantezlerle birlikte silen kodlara ihtiyacım var, yardımcı olacak olan hocalarıma şimdiden teşekkür ederim. Not: çözüm word içindede olabilir.
Saygılarımla 23.07.07
 
Son düzenleme:
Kod: 
Sub KoseliParantezleriKaldir()
    With CreateObject("vbscript.regexp")
        .Pattern = "\[.*\]"
        .Global = True
        For x = 1 To [A65536].End(3).Row
            Cells(x, 2) = .Replace(Cells(x, 1), "")
        Next
    End With
End Sub
 
Hocam, harikasınız, çok teşekkür ediyorum, bana gerçekten çok ama çok yardımcı oldunuz, saygılar sunuyorum, sayenizde bizde bu işi öğreneceğiz inşallh, kolay gelsin.
 
Affınıza sığınarak bir soru daha sormak istiyorum

Sub HÜCRE_AYIR()
Dim AD As String
Dim SOYAD As String
For HÜCRE = 1 To 65000 'DÖNGÜ SAYISINI SİZ VEREBİLİRSİNİZ. BURADA 1000 ALINDI
Range("A" & HÜCRE).Select
UZUNLUK = Len(Range("A" & HÜCRE).Text) 'BAŞVURULAN HÜCRENİN METİN UZUNLUĞU
For KARAKTER = 1 To UZUNLUK
If Mid(Range("A" & HÜCRE), KARAKTER, 1) = " " Then 'EĞER BAKILAN KARAKTER " " İSE AYIRMA İŞLEMİ YAPILACAK VE BİR SONRAKİ HÜCREYE GEÇİLECEK
AD = Left(Range("A" & HÜCRE), KARAKTER - 1)
SOYAD = Mid(Range("A" & HÜCRE), KARAKTER + 1, UZUNLUK - Len(AD))
'+1 VE -1 LER BOŞLUĞU ALMAMAK İÇİN EKLENDİ
Range("B" & HÜCRE).Value = AD
Range("C" & HÜCRE).Value = SOYAD
Exit For
End If
Next KARAKTER
Next HÜCRE
Range("A1").Select
End Sub

Kodlarını kullanarak a sutunundaki ilk kelimeleri ayırabiliyorum, ancak bu kelimelerden kırmızı renkli olanlar var, bunlar b sutununa ayrıldığında olduğu renklerle getirebilmek mümkünmüdür demiyeceğim tabikii excelde mümkündür ama bu sorunun cevabınıda yine üstadlarımızdan öğreneceğiz, şimdiden teşekkür ederim. Saygılarımla
 
Belki Fonksiyonlara çözümü bazı arkadaşlarımızın işine yarayabilir.

Kod: 
=IF(ISERROR(FIND("[";A1));A1;REPLACE(A1;FIND("[";A1);FIND("]";A1) - FIND("[";A1)+2;""))
 
=EĞER(EHATALIYSA(BUL("[";A1));A1;DEĞİŞTİR(A1;BUL("[";A1);BUL("]";A1) - BUL("[";A1)+2;""))
 
Necdet_Yesertener Hocam, ellerine sağlık, bude değişik bir altarnatif olarak arşivime alındı, sağolasınız varolasınız. Birde yukarıdaki soruma cevap bulursan sevineceğim.
 
Merhaba Sayın tahsinanarat,

Beni zorluyorsunuz bir acemi olarak :) kodlardan hareketle ne yaptığını tam olarak anlamak biraz zor oluyor.

Örnek dosyanızı sorunun tam olarak anlaşılması daha kolay olur diye düşünüyorum. Renkli sözcüklerin durumu nedir ne değildir merak ettim doğrusu.

Saygılar
 
İstediğim açıklamayı ekli dosya içerisinde bildirdim

Ekli dosyadan da anlaşılacağı gibi, a sutununda bulunan almanca kelimelerin bazıları renkli konumdalar, b sutununa bu almanca kelimeleri ayırıp bold yaptıktan sonra tekrar birleştirme yapıp word belgesine göndereceğim,
İstediğim, bu kelimelerden bazıları renkli durumdalar, ayırma işlemi sırasında renkler kayboluyor, ben aynı renkte kalmasını istiyorum, İlginize çok teşekker ediyor, cevabınızı sabırsızla bekliyorum. Saygılarımla
 
Selamlar,

Eğer amacınız A sütunundaki verilerin ilk kelimesi kırmızı olan hücreleri kalın ve kırmızı olarak düzenlemekse aşağıdaki kodu kullanabilirsiniz.

Kod: 
Sub KIRMIZI_RENKLİ_KELİMELERİ_DÜZENLE()
    For X = 1 To [A65536].End(3).Row
    UZUNLUK = WorksheetFunction.SearchB(" ", Cells(X, 1), 1) - 1
    For Y = 1 To UZUNLUK
    If Cells(X, 1).Characters(Start:=Y, Length:=1).Font.ColorIndex = 3 Then
    With Cells(X, 1).Characters(Start:=Y, Length:=1).Font
        .FontStyle = "Kalın"
        .ColorIndex = 3
    End With
    End If
    Next: Next
End Sub
 
COST_CONTROL Hocam ellerine sağlık, çok güzel bir çalışma olmuş, amacımız, kırmızı renklerde dahil ilk ;(noktalı virgüle) kadar olan Almanca yazılı kelimeleri bold yapmak, ayrıca parantes içerisindeki (isim) (edat) (zamir) gibi ibarelerinde bold olmasını sağlamaktır, yukarıda bu kelimeleri bold yapmak amaçlı ayırmaya çalışmıştım ama, sizin vermiş olduğunuz kodlarla benim istediğim olabilir diye düşünüyorum, ama yapamıyorum tabi Saygılar.
 
COST_CONTROL Hocamın
Sub KIRMIZI_RENKLİ_KELİMELERİ_DÜZENLE()
For X = 1 To [A65536].End(3).Row
UZUNLUK = WorksheetFunction.SearchB(" ", Cells(X, 1), 1) - 1
For Y = 1 To UZUNLUK
If Cells(X, 1).Characters(Start:=Y, Length:=1).Font.ColorIndex = -4105 Then
With Cells(X, 1).Characters(Start:=Y, Length:=1).Font
.FontStyle = "Kalın"
.ColorIndex = -4105
End With
End If
Next: Next
End Sub

Renk kodunu -4105 olarak değiştirip ilk kelimelerin de bold olmasına çözüm buldum, VEYSELEMRE hocamında köşeli parantezleri silen kodun çalıştırıldığında fondların bozulmadan parantezleri silmesini sağlayabilirsek çok mükemmel bir sonuç elde edeceğiz, emeği geçen bütün arkadaşlarıma, hocalarıma saygı ve selamlarımı sunarım.​
 
Son düzenleme:
Kod: 
Sub KoseliParantezleriKaldirIlkKelimeleriBoldYap()
    With CreateObject("vbscript.regexp")
        .Pattern = "\[.*\]"
        .Global = True
        For x = 1 To [A65536].End(3).Row
            mystr = Cells(x, 1)
            If .test(mystr) Then
                mystr = .Replace(mystr, "")
                mystr = Replace(mystr, "  ", " ")
                Cells(x, 1) = mystr
            End If
            uz = InStr(Cells(x, 1), " ")
            If uz > 0 Then
                Cells(x, 1).Characters(Start:=1, Length:=uz).Font.FontStyle = "Kalın"
                If Cells(x, 1).Characters(Start:=1, Length:=1).Font.ColorIndex = 3 Then
                    Cells(x, 1).Characters(Start:=1, Length:=uz).Font.ColorIndex = 3
                    Cells(x, 1).Characters(Start:=uz + 1).Font.ColorIndex = -4105
                End If
            End If
        Next
    End With
End Sub
 
Sayın veyselemre, kodları uyguladım, saadece ağzım açık seyretmekle yetindim, emeğinize ve elinize sağlık, allah sizleri başımızdan eksik etmesiz, gerçekten çok işe yaradı, umarım başkalarınında çok işin yarayacaktır, düşünsenize 60 Bin satırlık satırda bu işlemi değişik süzgeçlerden geçirerek yapmaya çalışıyordum, tekrar çok teşekkür ederim, Saygılar sunarım. Tahsin ANARAT
 
Yukarıda açmış olduğum konu başlığı ile ilgili sorunuz sayın hocalarımızın yardımlarıyla çözüldü, ben ,yine öğrenmek amaçlı olarak bir sorum daha olacak, yine aynı dosyada (parantezsil) bulunan parantez içerisindeki (isim), (edat),(gçşl.fiil), (gçşz.fiil) vs. parantez içerisindeki değerler çoğaltılabilir, bu değerlerin kod ile bold yapılmasını istiyorum, bu konuda da yardımcı olursanız çok sevinirim, şimdiden teşekkür ederim.
 
Kod: 
Sub KoseliParantezleriKaldirIlkKelimeleriveParantezIciKelimeleriBoldYap()
Application.ScreenUpdating = False
Dim objMatch As Object
Dim colMatches As Object
    Set reg1 = CreateObject("vbscript.regexp")
    Set reg2 = CreateObject("vbscript.regexp")
    With reg1
        .Pattern = "\[.*\]"
        .Global = True
    End With
    With reg2
        .Pattern = "\(+.[(gçşz\.fiil)|(gçşl\.fiil)|(isim)|(edat)]+\)"
        .Global = True
    End With
    For x = 1 To [A65536].End(3).Row
        With reg1
            myStr = Cells(x, 1)
            If .test(myStr) Then
                myStr = .Replace(myStr, "")
                myStr = Replace(myStr, "  ", " ")
                Cells(x, 1) = myStr
            End If
            uz = InStr(Cells(x, 1), " ")
            If uz > 0 Then
                Cells(x, 1).Characters(Start:=1, Length:=uz).Font.FontStyle = "Kalın"
                If Cells(x, 1).Characters(Start:=1, Length:=1).Font.ColorIndex = 3 Then
                    Cells(x, 1).Characters(Start:=1, Length:=uz).Font.ColorIndex = 3
                    Cells(x, 1).Characters(Start:=uz + 1).Font.ColorIndex = -4105
                End If
            End If
        End With
        With reg2
            myStr = Cells(x, 1)
            If (.test(myStr) = True) Then
                Set colMatches = .Execute(myStr)        ' Execute search.
                For Each objMatch In colMatches        ' Iterate Matches collection.
                    Cells(x, 1).Characters(Start:=objMatch.FirstIndex, Length:=objMatch.Length + 2).Font.FontStyle = "Kalın"
                Next
            End If
        End With
    Next
    Set reg1 = Nothing
    Set reg2 = Nothing
Application.ScreenUpdating = True
End Sub
 
Son düzenleme:
Yakınımda olsan alnınızdan öperdim, harikasınız yaw, çok teşekkür ediyorum, Allah sizden razı olsun, bütün istediklerim tek bir tıklama ile halloldu, daha ne isteyeyim sağolun, varolun.
 
Sayın veyselemre hocam, şimdi dikkatimi çekti, parentez içerisinde olmadığı halde içerisinde "\(gçşz.fiil|gçşl.fiil|isim|edat\)" sıfatı, isimi gibi kelemilerin sıfat ve isim kısımları da bold oluyor, yani parantez içerisinde olmadıkları halde, bu durum düzeltilebilinirmi, Teşekkürler.
 
Bu pattern işi bayağı karışık tam vakıf değilim, yukarıdaki kodları güncelledim, tekrar deneyin.
 
Denedim hocam oldu, eline sağlık, güzelleştikçe insan daha mükemmel olsun istiyor, hazır sizi bulmuşken bu konu il ilgili son sorumu soruyorum affınıza sığınarak tabi,
parantez içerisindeki isim, sıfat, edat gibi kelimeler word dosyasındaki orjinalinde " s ", " n ", " k " (her iki yanında da birer boşluk var)vs. gibi adlandırılıyor, ben bunları worde bul değiştir komutu ile (isim), (sıfat), (edat) şekline değiştiriyordum,
Sorum şu, yukarıdaki kodların içerisine bunuda sıkıştırabilirmiyiz, yani " s " Parantez içerisinde (isim), " n " ise (sıfat) olacek şekilde, bunlar çoğaltılabilir.
Çok şey istediğimin farkındayim ama bu da olursa wordaki orjinal şeklini isteğimiz gibi yapmış olacağız, tek tıklama ile iş bitmiş olacak, cevabınızı bekliyorum pc nin başında. Teşekkürler
 
Kodların başına aşağıdaki gibi eklemeleri yapabilirsiniz. Sayfadaki bütün " s " leri "(isim)" yapar. Diğerlerini bu şekilde de alt alta ekleyin.
Cells.Replace " s ", "(isim)"
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst