En son noktalı virgülden sonrakiler italik

[tahsinanarat]

Ekli dosyada bulunan ve aynı hücre içerisindeki en son ( Noktalıvirgülden sonrakileri italik yapmak istiyorum, yardımcı olacak arkadaşlara şimdiden çok teşekkür ederim. 15.08.2007 09.03

 

[AS3434]

Sayın tahsinarat

"En son noktalı virgül" demişsiniz ama, bazı satırlarınız da ";" yok bazılarıda da Türkçe kelimelerin arasında.
Bu haliyle nasıl olacak?

 

[tahsinanarat]

önemli olan en son noktalı virgülden sonraki kelimelerin italik olması, örnekte yanlışlık olmuş olabilir, benim için önemli olan en son noktalı virgülden sonrakilerin italik olması. Teşekkürler

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub DÜZENLE()
    For X = 1 To [A65536].End(3).Row
    SAY = 0
    If Cells(X, 1) Like "*" & ";" & "*" Then
    For Y = Len(Cells(X, 1)) To 1 Step -1
    If SAY = 1 Then GoTo Devam
    If Mid(Cells(X, 1), Y, 1) = ";" Then
    Cells(X, 1).Characters(Start:=Y + 1, Length:=Len(Cells(X, 1)) - Y).Font.FontStyle = "İtalik"
    Cells(X, 1).Characters(Start:=Y + 1, Length:=Len(Cells(X, 1)) - Y).Font.Bold = True 'Bu kod ";" den sonraki kısmı bold yapar. Dilerseniz silebilirsiniz.
    SAY = 1
    End If
    Next
Devam: End If: Next
    MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

 

[hsayar]

selam hocam 125,75 ytl yi bana 75 kısmı 8 punto olacak şekilde nasıl ayarlarız peki veya daha detaylı olarak ana puntodan 2 eksik olacak şekilde
yardımlarınız iiçin şimdiden teşekkürler

 

[tahsinanarat]

SN. cost_control hocam elinize ve emeğinize sağlık, tam istediğim gibi olmuş, çok teşekkür ediyorum, izninizle bir soru daha sormak istiyorum, eğer noktalı virgülden sonrakileri italik değilde silmek isteseydim nasıl bir kod yazmalıyız, bu değişik örnekleri arşivimde biriktiriyorum. Teşekkür ederim.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu kullanabilirsiniz.

Sub EN_SONDAKİ_NOKTALI_VİRGÜLDEN_SONRAKİ_KARAKTERLERİ_SİL()
    For X = 1 To [A65536].End(3).Row
    SAY = 0
    If Cells(X, 1) Like "*" & ";" & "*" Then
    For Y = Len(Cells(X, 1)) To 1 Step -1
    If SAY = 1 Then GoTo Devam
    If Mid(Cells(X, 1), Y, 1) = ";" Then
    Cells(X, 1) = Mid(Cells(X, 1), 1, Y)
    SAY = 1
    End If
    Next
Devam: End If: Next
    MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

 

[tahsinanarat]

hocam çok ama çok teşekkür ediyorum, sayenizde hem öğreniyoruz, hemde arşivimizi genişletiyorum, inşaallah biriktirdiklerimi derleyip bende bu siteye ekleyeceğim. Saygılar sunarım.

 

[tahsinanarat]

Cost_control hocam, cevap geldikçce değişik sorularda aklımıza geliyor, affınıza sığınarak birde şöyle bir soru sormak istiyorum, noktalı virgülden sonrakileri ayrı bir sutuna aktarmak istiyorum, cevabınız için şimdiden teşekkürler.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu kullanabilirsiniz.

Sub EN_SONDAKİ_NOKTALI_VİRGÜLDEN_SONRAKİ_KARAKTERLERİ_YANDAKİ_SÜTUNA_AKTAR()
    [B:B].ClearContents
    For X = 1 To [A65536].End(3).Row
    SAY = 0
    If Cells(X, 1) Like "*" & ";" & "*" Then
    For Y = Len(Cells(X, 1)) To 1 Step -1
    If SAY = 1 Then GoTo Devam
    If Mid(Cells(X, 1), Y, 1) = ";" Then
    Cells(X, 2) = Mid(Cells(X, 1), Y + 1, Len(Cells(X, 1)))
    SAY = 1
    End If
    Next
Devam: End If: Next
    MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

 

[tahsinanarat]

hocam çok teşekkür ediyorum, ilginize, başka bir konuda görüşmek üzere, saygılarımla

 

[tahsinanarat]

noktalıvirgül de dahil silmek isteseydik, kod nasıl olacaktı

cost_control hocam, noktalı virgül de dahil silmek istemiş olsaydık, kodda nasıl bir değişiklik olacaktı

Selamlar,

Aşağıdaki kodu kullanabilirsiniz.

Sub EN_SONDAKİ_NOKTALI_VİRGÜLDEN_SONRAKİ_KARAKTERLERİ_SİL()
    For X = 1 To [A65536].End(3).Row
    SAY = 0
    If Cells(X, 1) Like "*" & ";" & "*" Then
    For Y = Len(Cells(X, 1)) To 1 Step -1
    If SAY = 1 Then GoTo Devam
    If Mid(Cells(X, 1), Y, 1) = ";" Then
    Cells(X, 1) = Mid(Cells(X, 1), 1, Y)
    SAY = 1
    End If
    Next
Devam: End If: Next
    MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

 

[Orion1]

Merhaba.
Aşağıdaki kodu denermisiniz?

Sub noktali_virgül_dağil_sil()
For X = 1 To [A65536].End(3).Row
On Error Resume Next
    sil = Split(Cells(X, 1).Value, ";")
    Cells(X, 1).Value = sil(0)
Next
MsgBox "İŞLEM TAMAM.."
End Sub

 

[tahsinanarat]

Sayın Orion2, ilk noktalıvirgülden sonrakileri siliyor, ben son noktalıvirgülden sonrakileri virgül ile birlikte sildirmek istiyorum

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki ifade yerine;

Cells(X, 1) = Mid(Cells(X, 1), 1, Y)

Bu kodu kullanın.

Cells(X, 1) = Mid(Cells(X, 1), 1, Y-1)

 

[tahsinanarat]

Teşekkürler sayın cont_costrol hocam, diyecek bişey bulamıyorum saygılar, helal olsun, elinize sağlık

 

[Orion1]

Sayın Orion2, ilk noktalıvirgülden sonrakileri siliyor, ben son noktalıvirgülden sonrakileri virgül ile birlikte sildirmek istiyorum

Merhaba.
Sayın COST_CONTROL üstadımızın kodlarında küçük bir revizyon yaptım.
Aşağıdaki kodları denermisiniz.
Bu arada sayın üstadımız soruyu cevaplandırmış bile..!!

Sub EN_SONDAKİ_NOKTALI_VİRGÜLDE_Dagil_KARAKTERLERİ_SİL()
    For X = 1 To [A65536].End(3).Row
    SAY = 0
    If Cells(X, 1) Like "*" & ";" & "*" Then
    For Y = Len(Cells(X, 1)) To 1 Step -1
    If SAY = 1 Then GoTo Devam
    If Mid(Cells(X, 1), Y, 1) = ";" Then
    Cells(X, 1) = Mid(Cells(X, 1), 1, Y)
    SAY = 1
    End If
    Next
Devam:
Cells(X, 1).Value = Left(Cells(X, 1).Value, Len(Cells(X, 1).Value) - 1)
End If: Next
    MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub