Bir hücrede belli bir kısmı italik yapma

[karayel40]

Tek hücre içinde bulunan bu kaynakçada "Türkçeyi yabancı dil olarak öğrenenlerin dil yeterliklerine ilişkin ölçek geliştirme ve uygulama" kısmını italik yapmam gerekiyor. Bunun için ne yapabilirim?

İbiloğlu, Halide. (2022). Türkçeyi yabancı dil olarak öğrenenlerin dil yeterliklerine ilişkin ölçek geliştirme ve uygulama. (Yayımlanmamış yüksek lisans tezi). Akdeniz Üniversitesi Eğitim Bilimleri Enstitüsü.​

 

[TiOr]

Slm,

Bunun gibi mi?

 

[karayel40]

Altın üye olmadığım için göremiyorum maalesef.

Slm,

Bunun gibi mi?

Ekli dosyayı görüntüle 236538

 

[ÖmerFaruk]

Bunu VBA ile yapmak isterseniz aşağıdaki kod bloğunu kullanabilirsiniz.
Örnek dosyanız olmadığı için verdiğim kodlar sadece örnektir. Kendinize uyarlamanız lazım

Sub BelliKelimeleriItalicYap()
   Dim kelimeler As String, x1 As Integer, x2 As Integer
   'Örnek sadece A1 hücresi için yapılmıştır
   kelimeler = "Türkçeyi yabancı dil olarak öğrenenlerin dil yeterliklerine ilişkin ölçek geliştirme ve uygulama"
   x1 = InStr(1, Range("A1"), kelimeler)
   x2 = Len(kelimeler)
   Range("A1").Characters(Start:=x1, Length:=x2).Font.Italic = True
End Sub

 

[TiOr]

Altın üye olmadığım için göremiyorum maalesef.

Link olarak paylaştım.

İndir İTALİK

Dosyayı indir İTALİK

dosya.co

 

[karayel40]

Bunu VBA ile yapmak isterseniz aşağıdaki kod bloğunu kullanabilirsiniz.
Örnek dosyanız olmadığı için verdiğim kodlar sadece örnektir. Kendinize uyarlamanız lazım

Sub BelliKelimeleriItalicYap()
   Dim kelimeler As String, x1 As Integer, x2 As Integer
   'Örnek sadece A1 hücresi için yapılmıştır
   kelimeler = "Türkçeyi yabancı dil olarak öğrenenlerin dil yeterliklerine ilişkin ölçek geliştirme ve uygulama"
   x1 = InStr(1, Range("A1"), kelimeler)
   x2 = Len(kelimeler)
   Range("A1").Characters(Start:=x1, Length:=x2).Font.Italic = True
End Sub

Link olarak paylaştım.

İndir İTALİK

Dosyayı indir İTALİK

dosya.co

Aşağıdaki metni bir şablon olarak düşünün. 2. nokta ile 3. nokta arasını italik yapmam gereken 1000 kadar veri var.

Evli, Kader. (2022). Uzaktan eğitim sürecinde ortaokul öğrencilerinin yazma becerilerinin geliştirilmesine yönelik yöntemlerin incelenmesi. (Yayımlanmamış yüksek lisans tezi). Mersin Üniversitesi Eğitim Bilimleri Enstitüsü.​

Köse, Ünzile. (2022). Şehbenderzâde Filibeli Ahmed Hilmi'nin eserlerinin kök değerler açısından incelenmesi. (Yayımlanmamış yüksek lisans tezi). Akdeniz Üniversitesi Eğitim Bilimleri Enstitüsü.​

Demirtaş, Ercan. (2021). Öğretmenlerin medya okuryazarlık düzeylerinin çeşitli değişkenler açısından incelenmesi. (Yayımlanmamış yüksek lisans tezi). Ağrı İbrahim Çeçen Üniversitesi Lisansüstü Eğitim Enstitüsü.​

 

[ÖmerFaruk]

Verdiğim kodu denemediniz mi?

 

[TiOr]

@karayel40
Dosyanızı https://dosya.co/ bu siteye yükleyin ve linkini paylaşın.
@ÖmerFaruk hocamın paylaşımı ile yardımcı olalım inşallah.

 

[karayel40]

Verdiğim kodu denemediniz mi?

Denedim ama olmadı ya da ben beceremedim. Bir de siz dener misiniz?
Çok teşekkür ederim yardımcı olmaya çalıştığınız için @TiOr ve @ÖmerFaruk

İndir Seminer dosyası1

Dosyayı indir Seminer dosyası1

dosya.co

 

[TiOr]

@ÖmerFaruk Hocam Slm,
Sana zahmet paylaştığınız kodu belirli bir kelime içermeksiniz A:A sütununda 2. noktadan 3. noktaya kadar olan kısmını italik biçimlendirecek şekilde revize yapabilir misin? Yardımcı olmak maiyetinde dosyaya ben yedirir paylaşırım. Ayrıca dosyayı ekte paylaşıyorum. Hayırlı geceler...



Evli, Kader. (2022). Uzaktan eğitim sürecinde ortaokul öğrencilerinin yazma becerilerinin geliştirilmesine yönelik yöntemlerin incelenmesi. (Yayımlanmamış yüksek lisans tezi). Mersin Üniversitesi Eğitim Bilimleri Enstitüsü.

Sub BelliKelimeleriItalicYap()
   Dim kelimeler As String, x1 As Integer, x2 As Integer
   'Örnek sadece A1 hücresi için yapılmıştır
   kelimeler = "Türkçeyi yabancı dil olarak öğrenenlerin dil yeterliklerine ilişkin ölçek geliştirme ve uygulama"
   x1 = InStr(1, Range("A1"), kelimeler)
   x2 = Len(kelimeler)
   Range("A1").Characters(Start:=x1, Length:=x2).Font.Italic = True
End Sub

 

[Haluk]

Sub Test()
    myStr = Range("A1").Text
    
    xStr = Split(myStr, ".")(2)
    
    x1 = Len(Split(myStr, ".")(0) & Split(myStr, ".")(1))
    
    x2 = Len(xStr) + 3
    
    Range("A1").Characters(Start:=x1, Length:=x2).Font.Italic = True
End Sub

.

 

[TiOr]

@Haluk Hocam Selam,
Konu bana ait değil ama yardımcı olmak maiyetinde yazıyorum. Kodu dosyada düzenleyim link olarak paylaşım yapacağım sonrasında.
Şöyleki A sütununda bu şekilde 1137 adet kayır var.
İlettiğiniz kodda sadece A1 alıyor tüm sütunu içerir şekilde nasıl yapabiliriz kısmında yardımcı olabilir misiniz?
Teşekkürler, iyi çalışmalar.

 

[TiOr]

@Haluk Hocam Tekrar Selam,
Yaptım gerek kalmadı sağolasın emeğinize sağlık. Teşekkür ederim. Selamlar...

Sub Test()
    myStr = Range("A1").Text
    
    xStr = Split(myStr, ".")(2)
    
    x1 = Len(Split(myStr, ".")(0) & Split(myStr, ".")(1))
    
    x2 = Len(xStr) + 3
    
    Range("A:A").Characters(Start:=x1, Length:=x2).Font.Italic = True
End Sub

 

[TiOr]

@karayel40 Slm,

Dosyanız linke ve ektedir.

İndir Seminer dosyası1

Dosyayı indir Seminer dosyası1

dosya.co

Bu vesile ile @ÖmerFaruk ve @Haluk hocama teşekkür ederim emekleri için.

 

[Haluk]

Kodu döngüye alıp, çalıştırmak gerekir...

Sub Test()
    NoA = Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 1 To NoA
        myStr = Range("A" & i).Text
        
        xStr = Split(myStr, ".")(2)
        
        x1 = Len(Split(myStr, ".")(0) & Split(myStr, ".")(1))
        
        x2 = Len(xStr) + 3
        
        Range("A" & i).Characters(Start:=x1, Length:=x2).Font.Italic = True
    Next
End Sub

.

 

[karayel40]

Allah razı olsun. Beni büyük bir yükten kurtardınız. @Haluk ve @TiOr.

 

[ÖmerFaruk]

=)

 

[TiOr]

@karayel40 Slm,
Cümlemizden Allah razı olsun.
@Haluk hocamın bilgilendirmesine istinaden ekleri revize ettim.
Linkte ve ekte bulunan dosyayı dikkate alınız.
İyi çalışmalar, sağlıcakla kalın.

İndir Seminer dosyası1

Dosyayı indir Seminer dosyası1

dosya.co