Metinleri Parçalara Ayırmak

[MSCRoMuLuS]

Merhabalar;

Resimde paylaşmış olduğum, aynı hücre içinde ALT + ENTER ile alt alta yazılmış farklı özellikteki metinleri ayırmak istiyorum. Bilgim sınırlı olduğu için kafamda oluşturamadım. Tek satır şeklinde olursa da olabilir veyahut alt alta birden fazla satırda olursa makro nasıl şekillenir acaba.
Yardımcı olursanız çok sevinirim.

[/URL]

 

[YUSUF44]

Ekran görüntüsü yerine örnek excel dosyası paylaşmanızı tavsiye ederim.

B:F sütunları ilk hali, H:M sütunları olmasını istediğiniz haliyse ilk halindeki kırmızı metinlerin ya da hücre içindeki ilk satırın silinmesini mi istiyorsunuz?

 

[MSCRoMuLuS]

Ekran görüntüsü yerine örnek excel dosyası paylaşmanızı tavsiye ederim.

B:F sütunları ilk hali, H:M sütunları olmasını istediğiniz haliyse ilk halindeki kırmızı metinlerin ya da hücre içindeki ilk satırın silinmesini mi istiyorsunuz?

Evet ilk sutündaki kırmızı metinlerin silinmesini istiyorum Yusuf bey. Hatta yan tarafa yazılmasını istememin nedeni şu, bana aslında sadece hücredeki üstü çizili olmayan mavi metinler lazım. Yan taraftan kendim alıp bunların üstüne yapıştıracağım. Kısaca B:F hücrelerindeki kırmızı üstü çizgili metinleri silmek amacım. Şu anda pc başında olmadığım için örnek exceli akşam yükleyebilirim anca.

 

[YUSUF44]

Excel dosyası?

 

[Haluk]

=PARÇAAL(B2;BUL(DAMGA(10);B2);255)

.

 

[MSCRoMuLuS]

Excel dosyası?

Buyrun Yusuf Bey

https://dosya.co/4r74aiok18jw/ornek.xlsx.html

 

[Korhan Ayhan]

Merhaba,

Haluk beyin 5 nolu mesajında verdiği formülü denediniz mi?

 

[MSCRoMuLuS]

Merhaba,

Haluk beyin 5 nolu mesajında verdiği formülü denediniz mi?

Korhan bey haluk beyin formulünü denedim. öyle olduğu zaman metin özelliğini kaybediyor yani rengini. Makro olarak çözüme ulaşabilirsek süper olur. Lakin imkanı yoksa formül ile çözeceğim mecburen.

 

[Korhan Ayhan]

Aslında metinler sadece mavi renge sahipse formülle ayırdıktan sonra elle renklendirerek sonuca gidebilirsiniz.

 

[YUSUF44]

Buyrun Yusuf Bey

https://dosya.co/4r74aiok18jw/ornek.xlsx.html

Aşağıdaki makroyu dener misiniz?

Sub bol()
son = Cells(Rows.Count, "B").End(3).Row
Range("B2:F" & son).Copy [H2]
Application.ScreenUpdating = False
    For i = 2 To son
        For j = 8 To 13
            uzunluk = Len(Cells(i, j))
            For k = 2 To uzunluk
                If Cells(i, j).Characters(k, k).Font.Color = vbBlue Then
                    Cells(i, j).Characters(1, k - 1).Delete
                    k = uzunluk
                End If
            Next
        Next
    Next
Application.ScreenUpdating = True
End Sub