Hücrelerde üstü çizili metinleri birleştirme

[MSCRoMuLuS]

Merhabalar;
5200 satılık ve A'dan W'ya kadar giden sütunların bazı hücrelerinde aynı hücre içinde önce üstü çizgili yazılar devamında ise üstü çizgili olmayan kelimeler var.

iki hücredeki üstü çizgili olmayan kelimeleri başka bir hücrede birleştirebilirmiyim?

Formatı başka bir üst birim tarafından belirlenen resmi bir dosya olduğu için değişiklik yapma şansım ne yazık ki yok.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki KTF'yi kullanabilirsiniz.

KTF = Kullanıcı Tanımlı Fonksiyon

Option Explicit

Function K_BİRLEŞTİR(Alan1 As Range, Alan2 As Range, Optional Ayraç As String = " ")
    Dim X As Integer, Metin1 As String, Metin2 As String
   
    Application.Volatile True
   
    For X = 1 To Len(Alan1.Value)
        If Alan1.Characters(X, 1).Font.Strikethrough = False Then
            Metin1 = Metin1 & Mid(Alan1.Value, X, 1)
        End If
    Next

    For X = 1 To Len(Alan2.Value)
        If Alan2.Characters(X, 1).Font.Strikethrough = False Then
            Metin2 = Metin2 & Mid(Alan2.Value, X, 1)
        End If
    Next
   
    K_BİRLEŞTİR = WorksheetFunction.Trim(Metin1 & Ayraç & Metin2)
End Function

 

[MSCRoMuLuS]

Merhaba,

Aşağıdaki KTF'yi kullanabilirsiniz.

KTF = Kullanıcı Tanımlı Fonksiyon

Option Explicit

Function K_BİRLEŞTİR(Alan1 As Range, Alan2 As Range, Optional Ayraç As String = " ")
    Dim X As Integer, Metin1 As String, Metin2 As String
  
    Application.Volatile True
  
    For X = 1 To Len(Alan1.Value)
        If Alan1.Characters(X, 1).Font.Strikethrough = False Then
            Metin1 = Metin1 & Mid(Alan1.Value, X, 1)
        End If
    Next

    For X = 1 To Len(Alan2.Value)
        If Alan2.Characters(X, 1).Font.Strikethrough = False Then
            Metin2 = Metin2 & Mid(Alan2.Value, X, 1)
        End If
    Next
  
    K_BİRLEŞTİR = WorksheetFunction.Trim(Metin1 & Ayraç & Metin2)
End Function

Ekli dosyayı görüntüle 226124

Korhan bey çok teşekkür ederim. Evdeki örnek denemelerimde gayet güzel çalışıyor. yarında iş yerindeki asıl dosyada deneyeceğim. İyi Akşamlar