افزودن متن با قالب بندی متفاوت به سلول

Question

لری وظیفه جایگزینی یا اضافه کردن متن به هر سلول در یک ستون در چندین ورک بوک اکسل را بر عهده داشته است. مشکل این است که این متن جدید باید زیر خط کشیده شود و رنگ دیگری داشته باشد. یافتن و جایگزینی زیر خط و رنگ تمام متن در سلول ها، اما لری نیاز به قالب بندی برای اعمال فقط به متن اضافه شده است.

اگر فقط باید این نوع کار را چند بار انجام دهید، ساده ترین راه حل ممکن است کمک گرفتن از Microsoft Word باشد. می توانید محدوده سلول ها را در یک سند Word کپی کنید، از قابلیت های Words Find and Replace برای ایجاد تغییرات قالب بندی استفاده کنید، و سپس متن را به کاربرگ Excel خود کپی کنید.

اگر مجبورید این کار را بیشتر انجام دهید، بهترین روش استفاده از ماکرو است. ماکرو زیر را می توان برای تغییر متن در سلول های یک ستون یا اضافه کردن متن به سلول ها استفاده کرد.

Sub AddFormatedText()
    Dim K As Long
    Dim lCol As Long
    Dim LastRow As Long
    Dim sFind As String
    Dim sReplace As String
    Dim FullCells As Range
    Dim c As Range

     Column to work on
    lCol = 1

     Text to be replaced in the cell
     If this variable is empty, then
     the contents of sReplace are added
     to the end of the cell
    sFind = ""

     Text to replace sFind or to add to the cell
    sReplace = "More Text"

     Find last row in column A
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row

     Set range to check
    Set FullCells = Range(Cells(1, lCol), Cells(LastRow, lCol))
     Start looking through each cell
    For Each c In FullCells
        K = 0
         Only check if there is not a formula in the cell
         and if the cell has some text in it
        If Not c.HasFormula And Len(c.Text) > 0 Then
            If sFind > "" Then
                 Replace first found instance of text in sFind
                K = InStr(c.Text, sFind)
                If K > 0 Then
                    c = Left(c.Text, K - 1) & sReplace & _
                      Mid(c.Text, K + Len(sFind))
                End If
            Else
                K = Len(c.Text)
                 Add the text to the cell (plus a space)
                c = c & " " & sReplace
                 Adjust starting position for formatting
                K = K + 2
            End If
        End If

         Format the added text, if any
        If K > 0 Then
            With c.Characters(Start:=K, Length:=Len(sReplace)).Font
                .Underline = xlUnderlineStyleSingle
                .Color = vbRed
            End With
        End If
    Next c
End Sub

برای استفاده از ماکرو باید سه تغییر ایجاد کنید. اولین مورد این است که مطمئن شوید متغیر lCol روی شماره ستونی که می خواهید روی آن تأثیر بگذارید تنظیم شده است. دوم، شما باید sFind را برابر با متنی که می خواهید پیدا کنید و در سلول ها جایگزین کنید، تنظیم کنید. در صورت تمایل می توانید sFind را خالی بگذارید (همانطور که در بالا آمده است) اگر فقط می خواهید متنی را به سلول اضافه کنید. در نهایت، باید sReplace را برابر با چیزی که می خواهید جایگزین sFind کنید یا با چیزی که می خواهید به سلول ها اضافه شود، تنظیم کنید.

ماکرو از طریق هر سلول در ستون مشخص شده نگاه می کند و اگر سلول حاوی فرمول نباشد و از قبل متنی در آن باشد، متن شما را جایگزین یا اضافه می کند. در نهایت، اگر تغییری در سلول ایجاد شده باشد، هر آنچه در sReplace بود، زیر خط کشیده شده و قرمز می شود. باید توجه داشته باشید که اگر تغییری در سلول ایجاد شود، هر قالب بندی موجود در سلول با تغییر ایجاد شده لغو می شود.