hücre içi metin biçimi

merttbey · 30 Eylül 2011

bir hücre içine yazdığımız üç kelimeyi aralarında 5 er karakter boşluk bırakacak şekilde aralayacak isteğe göre biçimlendirsek, ve aralarında 5 er karakter otomatik aralasa bide asıl öğrenmek istediğim aynı hücre içinde alt+enter yapıp alt satıra yazdığımız üç kelimeyide bu şekilde biçimlendirebilirmiyiz

Korhan Ayhan · 1 Ekim 2011

Merhaba,

Bence bu işlemi makro ile yapmak daha uygun. Aşağıdaki kodu sayfanızın kod bölümüne uygulayınız.

A sütununa veri girip deneyiniz.

Kod:

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Veri, Kelime, X, Y, Yeni_Veri
 
    On Error GoTo Son
 
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If InStr(1, Target, "     ") > 0 Then Exit Sub
 
    Application.EnableEvents = False
    Veri = Split(Target.Text, Chr(10))
    Target.ClearContents
 
    For X = 0 To UBound(Veri)
        Yeni_Veri = ""
        Kelime = Split(Veri(X), " ")
        For Y = 0 To UBound(Kelime)
            Yeni_Veri = IIf(Yeni_Veri = "", Kelime(Y), Yeni_Veri & "     " & Kelime(Y))
        Next
 
        If Target = "" Then
            Target = Yeni_Veri
        ElseIf Target <> "" And X <= UBound(Veri) Then
            Target = Target & Chr(10) & Yeni_Veri
        End If
    Next
 
Son:
    Application.EnableEvents = True
End Sub

merttbey · 1 Ekim 2011

Korhan hocam makro çok güzel çalışıyor.Ancak hücre içinde Alt+Enter yaptığımda 2.satıra yazdıklarım aralanmıyor

Korhan Ayhan · 1 Ekim 2011

Merhaba,

Hücreye alt+enter ile baraber yazmanız gereken veriyi aralarına birer boşluk vererek yazın kod çalışacaktır.

Örnek hücreye;

Ali Ali Ali
Deneme Deneme Deneme

Yazıp enter tuşuna basın ve sonucu görün.

merttbey · 1 Ekim 2011

Korhan hocam sen excel kullanıyosan biz ne kullanıyoz bilmiyom.Hayran kaldım,çok çok teşekkürler

merttbey · 1 Ekim 2011

Korhan hocam bişey daha sormak istiyorum, bu biçimlendirmeyi şu şekilde yapabilirmiyiz ; ilk kelime 25 karakterle sınırlandırılsa ve en sola yaslansa 2.keli 15 karakterle sınırlansa ve orta sağa yaslansa ve 3. kelime 10 karakterle sınırlansa ve en sağa yaslansa. Alt+Enter ile ikinci satırı yazarkende hepsi bi düzen içinde gözükse olurmu

Korhan Ayhan · 1 Ekim 2011

Merhaba,

Uzunluk sınırlaması yapılabilir fakat hizalama sadece bir şekilde yapılabilir. Yani ya ortalayabilirsiniz ya da sağa,sola hizalayabilirsiniz.

merttbey · 3 Ekim 2011

Korhan hocam bu konuyla alakalı son bi yardım isticem sizden, şöyle bişey yapabilirmiyiz ilk kelimeyi 25, ikinci kelimeyi 11 , üçüncü kelimeyi de 11 karakterle sınırlasak. Bide örneğin ilk kelime için 25 değilde 13 karakter bişey yazdıysam kalan 12 karakteri boşlukla tamamlansa 2. ve 3 kelimelerde bu şekilde eksiği boşlukla tamamlasa olur mu?

halit3 · 3 Ekim 2011

Alternatif olarak kod
1-A sutünu 25 karekterle sınırlı,
2-B sutünu 11 karekterle sınırlı,
3-C sutünu 13 karekterle sınırlı.

Kod:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A:C")) Is Nothing Then Exit Sub
Dim karekter1 As String, karekter2 As String, karekter3 As String
Dim bosluk1 As String, bosluk2 As String, bosluk3 As String
Application.EnableEvents = False
karekter1 = 25
karekter2 = 11
karekter3 = 13
bosluk1 = " "
bosluk2 = " "
bosluk3 = " "
If Target.Column = 1 Then
Target.Value = RightPadChar(Target.Value, bosluk1, Val(karekter1))
ElseIf Target.Column = 2 Then
Target.Value = RightPadChar(Target.Value, bosluk2, Val(karekter2))
ElseIf Target.Column = 3 Then
Target.Value = RightPadChar(Target.Value, bosluk3, Val(karekter3))
End If
Application.EnableEvents = True
End Sub
Function RightPadChar(ByVal Astr As String, PadChar As String, stLen As Integer) As String
Dim AStrL As Integer
Astr = Trim(Astr)
AStrL = Len(Astr)
If AStrL < stLen Then
Astr = Astr + String(stLen - AStrL, PadChar)
Else
Astr = Mid$(Astr, 1, stLen)
End If
RightPadChar = Astr
End Function
Function LeftPadChar(ByVal Astr As String, PadChar As String, stLen As Integer) As String
Dim AStrL As Integer
Astr = Trim(Astr)
AStrL = Len(Astr)
If AStrL < stLen Then
Astr = String(stLen - AStrL, PadChar) + Astr
Else
Astr = Mid$(Astr, 1, stLen)
End If
LeftPadChar = Astr
End Function

Örnek dosyanızı ekleseydiniz belki farklı çözümler bulunurdu.

merttbey · 3 Ekim 2011

Halit hocam öncelikle ilgi,alakanıza ve emeğinize çok teşekkür ederim.Bu konu ile ilgili bu konu başlığında Korhan hocamın yazmış olduğu bi kod vardı 2 nolu mesaj.Benim istediğim aynı hücre içerisinde bu işlemleri yapması, ekte Korhan hocamın yazmış olduğu kodla çalışan bi örnek dosya var inceleyebilirseniz sevinirim.

Korhan Ayhan · 3 Ekim 2011

Merhaba,

Anladığım kadarıyla siz açıklama kısmındaki verileri aynı hizada göstermek istiyorsunuz. Fakat istediğiniz gibide yapsak istediğiniz performansı alamayız. Ben yinede örnek kodu veriyorum. Kod 3 kelimeye göre sınırlıdır. Arttırmak isterseniz kodu revize etmek gerekir.

Hücreye verinizi aşağıdaki gibi yazmalısınız.

ELMA_KIRMIZI 5KG 7,50
PATLICAN_BOSTAN 25KG 6,48

Kod:

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Veri, Kelime, X, Y, Yeni_Veri, WF As WorksheetFunction
    Dim Uzunluk_1 As Byte, Uzunluk_2 As Byte, Uzunluk_3 As Byte
 
    On Error GoTo Son
 
    If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    
    Application.EnableEvents = False
    Set WF = WorksheetFunction
    Target = WF.Trim(Target.Text)
    If InStr(1, Target, "  ") > 0 Then GoTo Son
    
    Uzunluk_1 = 25
    Uzunluk_2 = 11
    Uzunluk_3 = 11
 
    Veri = Split(Target.Text, Chr(10))
    Target.ClearContents
 
    For X = 0 To UBound(Veri)
        Yeni_Veri = ""
        Kelime = Split(Veri(X), " ")
        For Y = 0 To UBound(Kelime)
            Select Case Y
                Case Is = 0
                    If Yeni_Veri = "" Then
                        Yeni_Veri = Kelime(Y) & WorksheetFunction.Rept(" ", Uzunluk_1 - Len(Kelime(Y)))
                    Else
                        Yeni_Veri = Yeni_Veri & Space(2) & (Kelime(Y) & WorksheetFunction.Rept(" ", Uzunluk_1 - Len(Kelime(Y))))
                    End If
                Case Is = 1
                    If Yeni_Veri = "" Then
                        Yeni_Veri = WorksheetFunction.Rept(" ", Uzunluk_2 - Len(Kelime(Y))) & Kelime(Y)
                    Else
                        Yeni_Veri = Yeni_Veri & Space(2) & WorksheetFunction.Rept(" ", Uzunluk_2 - Len(Kelime(Y))) & Kelime(Y)
                    End If
                Case Is = 2
                    If Yeni_Veri = "" Then
                        Yeni_Veri = WorksheetFunction.Rept(" ", Uzunluk_3 - Len(Kelime(Y))) & Kelime(Y)
                    Else
                        Yeni_Veri = Yeni_Veri & Space(2) & WorksheetFunction.Rept(" ", Uzunluk_3 - Len(Kelime(Y))) & Kelime(Y)
                    End If
            End Select
        Next
 
        If Target = "" Then
            Target = Yeni_Veri
        ElseIf Target <> "" And X <= UBound(Veri) Then
            Target = Target & Chr(10) & Yeni_Veri
        End If
        Target.HorizontalAlignment = xlDistributed
        Target.Font.Name = "Courier"
    Next
 
Son:
    Set WF = Nothing
    Application.EnableEvents = True
End Sub

merttbey · 3 Ekim 2011

Korhan hocam sizi çok uğraştırdım ama istediğim oldu.Çok Çok teşekkürler elinize sağlık. Kodta kelime arası boşlukları "*" tanımladım boşlıkla da yazabiliyorum.Çok sağolun

Ömer · 3 Ekim 2011

Merhaba,

İlgimi çektiği için soruyorum.

İstediğiniz hizalama,

Örnek 1 deki gibi mi yoksa Örnek 2 deki gibi mi?

.

merttbey · 3 Ekim 2011

ömer hocam örnek 2 tam istediğim gibi yanlız aynı hücre içerisinde kullanmam gerekli bunları

Ömer · 3 Ekim 2011

merttbey' Alıntı:
ömer hocam örnek 2 tam istediğim gibi yanlız aynı hücre içerisinde kullanmam gerekli bunları

Bu şekilde denermisiniz.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim Grup1, Grup2, i As Integer, j As Integer, Wf As WorksheetFunction
    Dim Metin As String, u1 As Integer, u2 As Integer
 
    On Error GoTo son
    If Intersect(Target, Range("C2:C" & Rows.Count)) Is Nothing Then Exit Sub
 
    Application.EnableEvents = False
 
    u1 = 25: u2 = 11
    Set Wf = WorksheetFunction
    Grup1 = Split(Target, Chr(10))
    For i = 0 To UBound(Grup1)
        Grup2 = Split(Grup1(i), " ")
        For j = 0 To UBound(Grup2)
            If j = 0 Then
                Metin = Metin & Grup2(j) & Wf.Rept(" ", u1 - Len(Grup2(j)))
            Else
                Metin = Metin & Wf.Rept(" ", u2 - Len(Grup2(j))) & Grup2(j)
            End If
        Next j
        Metin = Metin & Chr(10)
    Next i
 
    Target.Font.Name = "Courier"
    Target = Metin
 
son:
    Set Wf = Nothing
    Application.EnableEvents = True
 
End Sub

.

merttbey · 3 Ekim 2011

Ömer hocam ben 14 nolu mesajda düzeltme yapmıştım ama siz onu görmeden önce kodu yazdınız heralde. Benim istediğim aynı hücre içerisinde Alt+Enter yaptığımda da alt satıra yazdıklarım da bu biçime göre biçimlenmesi.Verileri bu şekilde girmem gerekiyor alt+enter ile 10 hatta 20 satırakadar açıklama girdiğim oluyor.

Ömer · 3 Ekim 2011

#15 numaralı mesajı düzenledim, Tekrar denermisiniz.

Korhan Ayhan · 4 Ekim 2011

Merhaba,

Bende üstteki mesajımdaki koda birkaç ilave yaptım. Yalnız birden fazla kelime içeren ürün isimlerinde "*" işaretini nasıl kullandığınızı anlayamadım.

merttbey · 4 Ekim 2011

Korhan hocam , Ömer hocam Allah sizden razı olsun öyle süper olduki tam istediğim gibi sizlere çok çok teşekkür ederim.
Korhan hocam kodtaki kelime arası boşlukları "*" olarak değiştirdim elma armut kiraz*15 kg*5,00 TL şeklinde girebiliyorum ve
elma armut kiraz 15 kg 5,00 TL şeklinde sonuç alabiliyorum.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Grup1, Grup2, i As Integer, j As Integer, Wf As WorksheetFunction
Dim Metin As String, u1 As Integer, u2 As Integer

On Error GoTo son
If Intersect(Target, Range("C10:C" & Rows.Count)) Is Nothing Then Exit Sub

Application.EnableEvents = False

u1 = 25: u2 = 11
Set Wf = WorksheetFunction
Grup1 = Split(Target, Chr(10))
For i = 0 To UBound(Grup1)
Grup2 = Split(Grup1(i), "*")
For j = 0 To UBound(Grup2)
If j = 0 Then
Metin = Metin & Grup2(j) & Wf.Rept(" ", u1 - Len(Grup2(j)))
Else
Metin = Metin & Wf.Rept(" ", u2 - Len(Grup2(j))) & Grup2(j)
End If
Next j
Metin = Metin & Chr(10)
Next i

Target.Font.Name = "Courier"
Target = Metin

son:
Set Wf = Nothing
Application.EnableEvents = True

End Sub

hücre içi metin biçimi

merttbey

Korhan Ayhan

Administrator

merttbey

Korhan Ayhan

Administrator

merttbey

merttbey

Korhan Ayhan

Administrator

merttbey

halit3

Uzman

Ekli dosyalar

merttbey

Ekli dosyalar

Korhan Ayhan

Administrator

merttbey

Ömer

Moderatör

merttbey

Ömer

Moderatör

merttbey

Ömer

Moderatör

Korhan Ayhan

Administrator

merttbey