حذف سلول های حاوی اصطلاحات خاص

Question

Ankur دارای یک کاربرگ است که دارای هزاران سلول حاوی اصطلاحات مختلف است. او باید تعداد زیادی از آن اصطلاحات و سلول هایی را که در آنها وجود دارند حذف کند. برای مثال، ممکن است لازم باشد تمام سلول های حاوی عباراتی مانند «google»، «youtube»، «linkedin» و بسیاری از اصطلاحات دیگر را حذف کند. آنکور می داند که می تواند هر یک از این عبارات را جستجو و جایگزین کند، اما این کاملا خسته کننده است. او فکر می کند که آیا راهی وجود دارد که بتواند تمام عباراتی را که باید حذف شوند شناسایی کند و سپس اکسل آنها را از هزاران سلول حذف کند.

اگر نیاز به انجام این نوع کارها به طور منظم دارید، بهترین راه حل استفاده از ماکرو است. ترفند این است که چگونه در ماکرو دقیقاً چه چیزی را می خواهید جایگزین کنید مشخص کنید. یک راه این است که اطلاعات را در یک آرایه قرار دهید، مانند مثال زیر:

Sub RemoveTerms1()
    Dim vTerm As Variant
    Dim vArray As Variant

    vArray = Array("google", "youtube", "linkedin")
    For Each vTerm in vArray
        Selection.Replace What:=vTerm, _
          Replacement:="", LookAt:=xlPart
    Next vTerm
End Sub

عبارات مورد جستجو در آرایه vArray قرار می گیرند و سپس هر یک از اعضای آرایه (هر عبارت) از آن عبور می کنند. متد Replace با شی Selection برای انجام تعویض های واقعی استفاده می شود. ماکرو سلول ها را حذف نمی کند. به سادگی هر متنی را که با این اصطلاح مطابقت دارد حذف می کند. هنگام جایگزینی، جستجو به حروف بزرگ و کوچک حساس نیست، بنابراین "google" با "Google" مطابقت دارد.

از آنجایی که شی Selection استفاده می شود، مهم است که مطمئن شوید لیستی را که می خواهید پردازش کنید، قبل از اجرای ماکرو انتخاب کنید. اگر این کار را نکنید، هیچ چیز جایگزین نمی شود.

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

Sub RemoveTerms2()
    Dim c As Range
    Dim rngSource As Range
    Dim vTerm As Variant
    Dim arrTerms As Variant
    Dim i As Integer

    i = -1
    arrTerms = Array()
    For Each c In Range("D1:D9").Cells
        If Trim(c.Value) > "" Then
            i = i + 1
            ReDim Preserve arrTerms(i)
            arrTerms(i) = Trim(c.Value)
        End If
    Next c

    On Error Resume Next
    Set rngSource = Application.InputBox( _
                    Prompt:="Please select Range", _
                    Title:="Removing Cells Containing Terms", _
                    Default:=ActiveSheet.UsedRange.Address, Type:=8)
    On Error GoTo 0
    If rngSource Is Nothing Then
        MsgBox ("You didnt specify a range to process")
    Else
        For Each vTerm in arrTerms
            rngSource.Replace What:=vTerm, _
              Replacement:="", LookAt:=xlWhole
        Next vTerm
    End If
End Sub

این ماکرو عبارات جستجو را از محدوده D1:D9 می کشد و سپس از شما می خواهد محدوده سلول هایی را که می خواهید پردازش کنید انتخاب کنید. از همان روش Replace استفاده می کند که در ماکرو قبلی استفاده شده بود، با این تفاوت که پارامتر LookAt را xlWhole تعیین می کند. این بدان معناست که عبارت جستجو باید با کل سلول مطابقت داشته باشد تا حذف شود. با این حال، اصطلاحات هنوز به حروف بزرگ و کوچک حساس نیستند.

توجه داشته باشید که نمونه هایی که تاکنون ارائه شده اند در واقع هیچ سلولی را حذف نمی کنند. آنها به سادگی محتویات سلول ها را حذف می کنند. در بسیاری از موارد این دقیقاً همان چیزی است که شما می خواهید زیرا نمی خواهید طرح بندی کاربرگ واقعی را مختل کنید. اگر واقعاً می خواهید سلول ها را حذف کنید، از روش جایگزینی استفاده نمی کنید. در عوض، می توانید مقایسه متن گسترده را روشن کنید و از عملگر Like استفاده کنید تا ببینید آیا مطابقت دارد یا خیر.

Option Compare Text

Sub RemoveTerms3()
    Dim c As Range
    Dim rngSource As Range
    Dim vTerm As Variant
    Dim arrTerms As Variant
    Dim i As Integer
    Dim sLook As String

    i = -1
    arrTerms = Array()
    For Each c In Range("D1:D9").Cells
        If Trim(c.Value) > "" Then
            i = i + 1
            ReDim Preserve arrTerms(i)
            arrTerms(i) = Trim(c.Value)
        End If
    Next c

    On Error Resume Next
    Set rngSource = Application.InputBox( _
                    Prompt:="Please select Range", _
                    Title:="Removing Cells Containing Terms", _
                    Default:=ActiveSheet.UsedRange.Address, Type:=8)
    On Error GoTo 0
    If rngSource Is Nothing Then
        MsgBox ("You didnt specify a range to process")
    Else
        For Each vTerm in arrTerms
            sLook = "*" & vTerm & "*"
            For Each c In rngSource
                If c.Value Like sLook Then c.Delete
            Next
        Next vTerm
    End If
End Sub

توجه داشته باشید که عبارات جستجو هنوز از محدوده D1:D9 خارج می شوند و همچنان از شما محدوده مورد نظر برای پردازش خواسته می شود. از آنجا، اما، روند متفاوت است: ماکرو هر سلول را بررسی می کند و اگر تطابق جزئی وجود داشته باشد، سلول حذف می شود.

برای اینکه این تغییر در ماکرو به درستی کار کند، باید خط Option Compare Text را خارج از خود رویه قرار دهید. این به VBA دستور می دهد تا کلمات کلیدی (مانند Like) را فعال کند که امکان مقایسه متن را فراهم می کند.