cümledeki ilk boşluğa ":" iki nokta üst üste koymak istiyorum

[tahsinanarat]

cümledeki ilk boşluğa ":" iki nokta üst üste koymak istiyorum

Ekili dosyada A sutununda bulunan cümle içerisinde ilk kelimeden sonra ":" olması gerekiyor, bazılarında yok. Makro ile ilk kelimenin hitamına olmayanlara ":" koydurabilirmiyiz. İlginize şimdiden teşekkür ederim.

 

[AS3434]

Sayın tahsinanarat

Dün gece pek çok şekli ile denedim, ama bir türlü yapamadım.
İlk boşluğa ":" koyulabiliyor, ama sizin dosyanızda biçimlendirmeden dolayı epey zor. Çünkü , ":" koyduğumuz satırlardaki kısmi "bold" biçimlendirmeler kayboluyor.



=EĞER(EHATALIYSA(BUL(":";A1));YERİNEKOY(A1;" ";":";1);A1)

=PARÇAAL(A26;1;BUL(" ";A26))&":"&PARÇAAL(A26;BUL(" ";A26)+1;UZUNLUK(A26))

Bu formülasyonları makro ile uygulayınca dediğim gibi bold yazı tipi normale dönüşüyor. O da anladığım kadarı ile işinize yaramıyor..

 

[tahsinanarat]

Sayın tahsinanarat

Dün gece pek çok şekli ile denedim, ama bir türlü yapamadım.
İlk boşluğa ":" koyulabiliyor, ama sizin dosyanızda biçimlendirmeden dolayı epey zor. Çünkü , ":" koyduğumuz satırlardaki kısmi "bold" biçimlendirmeler kayboluyor.



=EĞER(EHATALIYSA(BUL(":";A1));YERİNEKOY(A1;" ";":";1);A1)

=PARÇAAL(A26;1;BUL(" ";A26))&":"&PARÇAAL(A26;BUL(" ";A26)+1;UZUNLUK(A26))

Bu formülasyonları makro ile uygulayınca dediğim gibi bold yazı tipi normale dönüşüyor. O da anladığım kadarı ile işinize yaramıyor..

Bu şekilde de olsa işime yarayacak başka dosyalarım var, kodları yazarsanız sevinirim. Saygılarımla

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz. A sütunundaki listeyi B sütununa istediğiniz eklemeyi yaparak listeler. Tek sıkıntı Sn. AS3434 'ünde belirttiği gibi kelimelerdeki bold görüntü yeni listede kaybolmaktadır.

Sub İKİ_NOKTA_ÜST_ÜSTE_EKLE()
    [B:B].ClearContents
    For X = 1 To [A65536].End(3).Row
    BUL_BOŞLUK = WorksheetFunction.Search(" ", Cells(X, 1), 1)
    If Not Mid(Cells(X, 1), 1, BUL_BOŞLUK - 1) Like "*" & ":" & "*" Then
    Cells(X, 2) = Mid(Cells(X, 1), 1, BUL_BOŞLUK - 1) & ":" & Mid(Cells(X, 1), BUL_BOŞLUK, Len(Cells(X, 1)) - BUL_BOŞLUK)
    End If
    Cells(X, 2) = Cells(X, 1)
    Next
    MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

 

[tahsinanarat]

Sn. COST_CONTROL Hocam kodları denedim, iki nokta koyduramadım, tekrar bakabilirmisiniz

 

[AS3434]

Kodları şöyle deneyin.

Sub Makro1()
Application.ScreenUpdating = False
Set wf = WorksheetFunction
On Error Resume Next
For a = 1 To [a65536].End(3).Row
[COLOR=red]bu = Cells(a, 1).Find(":")[/COLOR]
[COLOR=red]be = wf.Find(" ", Cells(a, 1))[/COLOR]
[COLOR=red]If bu < 1 Then Cells(a, 1) = Mid(Cells(a, 1), 1, be) & " : " & Mid(Cells(a, 1), be + 1, Len(Cells(a, 1)))[/COLOR]
z = wf.Find(":", Cells(a, 1))
y = wf.Find("(", Cells(a, 1))
If y - z > 2 Then
Cells(a, "a").Characters(Start:=z + 1, Length:=y - z - 1).Font.FontStyle = "italik"
End If
Next
Application.ScreenUpdating = True
End Sub

Kırmızı kısım ilk boşluğu ":" yapar. (":" olmayan satırlarda tabii)

denemelerime göre hücre biçimleri de bozulmuyor.

Not. Gece farketmedim ama hücre biçimlerinin bozulduğunu şimdi farkettim.

 

[tahsinanarat]

İlginize çok teşekker ederim sn.AS34AS hocam. ellerinize sağlık