Mbak @anggun123 ...

Maksudnya mbak mau mengganti teks dengan pola WA:* ya? Misalkan WA:08888882123 menjadi HP : 08888882123? Kalau seperti maksudnya, coba script berikut :

Sub ReplaceText()
    Dim sTxt As String, sNum As String
    Dim xCell As Variant
    Dim xRE As Object
    Dim lIdx As Long
    
    Set xRE = CreateObject("vbScript.RegExp")
    
    xRE.Global = False
    xRE.IgnoreCase = True
    xRE.Pattern = "WA:.*"
    
    If Selection.Count > 0 Then
        For Each xCell In Selection
            sTxt = xCell.Value2
            If xRE.Test(sTxt) Then
                xRE.Pattern = "(-?\d*\.?\d+){10}"
                sTxt = xRE.Execute(sTxt)(0)
                xCell.Value = "HP : " & sTxt
            End If
        Next
    End If
End Sub

Note: Seleksi terlebih dahulu data yang akan diproses. Atau, untuk lebih aman, gunakan range object seperti berikut :

Sub ReplaceText2()
    Dim sTxt As String, sNum As String
    Dim xlCell As Range
    Dim xRE As Object
    Dim lIdx As Long
    
    Set xRE = CreateObject("vbScript.RegExp")
    
    xRE.Global = False
    xRE.IgnoreCase = True
    xRE.Pattern = "(-?\d*\.?\d+){10}"
    
    For Each xlCell In Sheet3.Range("B1:B50")
        If Len(xlCell.Value2) Then
            sTxt = xlCell.Value2
            If xRE.Test(sTxt) Then
                sTxt = xRE.Execute(sTxt)(0)
                xlCell.Value2 = "HP : " & sTxt
            End If
        End If
    Next
End Sub

Demikian.

Mbak @anggun123 ...

Saya contohkan dengan prosedur yang sama seperti di atas, contoh:

Sub ReplaceText2()
    Dim xlCell As Range
    Dim sTxt As String
    Dim xRE As Object
    Dim lIdx As Long
    
    Set xRE = CreateObject("vbScript.RegExp")
    
    xRE.Global = False
    xRE.IgnoreCase = True
    xRE.Pattern = "WA.(-?\d*\.?\d+){10}"
    
    For Each xlCell In Sheet3.Range("B33:B36")
        If Len(xlCell.Value2) Then
            sTxt = xlCell.Value2
            If xRE.Test(sTxt) Then
                sTxt = xRE.Replace(sTxt, "")
                xlCell.Value2 = sTxt
            End If
        End If
    Next
End Sub

Demikian.

Mbak @anggun123 ...

Angka 10 pada script berikut :

xRE.Pattern = "WA.(-?\d*\.?\d+){10}"

tujuannya untuk menentukan bahwa karakter angka yang akan dicocokkan minimal 10 karakter. Apabila ada kumpulan angka kurang dari 10 karakter dianggap tidak cocok (Not Match). Kalau tidak ingin menggunakan pola tersebut, bisa dihapus saja, seperti berikut :

xRE.Pattern = "WA.(-?\d*\.?\d+)"

Sedangkan untuk pertanyaan kedua, bisa dicoba dengan menggunakan pola :

xRE.Pattern = "WA.(-?\d*\.?\d+){10}|(Rp.[0-9]*)"

atau dengan menggunakan pola :

xRE.Pattern = "WA.(-?\d*\.?\d+)|Rp.*([0-9]*(\.|\,|\d)*)"

Note: untuk menghapus kata / kalimat yang cocok dari kedua pola tersebut, maka properti Global dari fungsi Regex harus aktif :

xRE.Global = True

Contoh script lain yang bisa digunakan :

Sub ReplaceText2()
    Dim vPattern As Variant
    Dim xlCell As Range
    Dim sTxt As String
    Dim xRE As Object
    
    Set xRE = CreateObject("vbScript.RegExp")
    
    xRE.Global = True
    xRE.IgnoreCase = True
    xRE.Pattern = "WA.(-?\d*\.?\d+){10}|(Rp.[0-9]*)"
    
    For Each xlCell In Sheet3.Range("B33:B38")
        If Len(xlCell.Value2) Then
            sTxt = xlCell.Value2
            For Each vPattern In Array("WA.(-?\d*\.?\d+){10}", "(Rp.[0-9]*)")
                xRE.Pattern = vPattern
                If xRE.Test(sTxt) Then
                    sTxt = xRE.Replace(sTxt, "")
                End If
            Next
            xlCell.Value2 = sTxt
        End If
    Next
End Sub

Demikian.

Mbak @anggun123 ...

Coba gunakan script di bawah ini, saya perbaiki dari script sebelumnya di atas :

Option Explicit

Public Sub HapusTeks()
    Dim vBuffer As Variant, vPattern As Variant, vItem As Variant
    Dim sText As String, sPattern As String
    Dim xlRange As Range
    Dim xRE As Object
    Dim lIdx As Long
    
    '+-- Inisilisasi objek Regex.
    Set xRE = CreateObject("vbScript.RegExp")
    xRE.IgnoreCase = True
    xRE.Global = True
    
    '+-- Konversi range ke array.
    Set xlRange = Sheet1.Range("B1:B10")
    vBuffer = xlRange
    
    '+-- Pola kata yang akan dicari.
    vPattern = Array( _
        "([a-z]+://[a-z0-9.-]+)[^ ]*", _
        "WA.(-?\d*\.?\d+){10}", _
        "(Rp.[0-9]*)" _
    )
    
    '+-- Pengulangan untuk setiap data.
    For lIdx = LBound(vBuffer) To UBound(vBuffer)
        sText = vBuffer(lIdx, 1)
        '+-- Proses jika data ada isinya.
        If Trim(sText) <> vbNullString Then
            '+-- Periksa setiap pola.
            For Each vItem In vPattern
                xRE.Pattern = vItem
                If xRE.Test(sText) Then
                    '+-- Jika pola ditemukan.
                    sText = xRE.Replace(sText, "")
                End If
            Next
            
            '+-- Hapus kelebihan spasi.
            xRE.Pattern = "\s{2,}"
            sText = xRE.Replace(sText, " ")
            
            '+-- Salin ulang data.
            vBuffer(lIdx, 1) = sText
        End If
    Next
    
    '+-- Untuk mengubah nilai pada range sebenarnya,
    '+-- gunakan perintah berikut :
    '+-- xlRange.Value2 = vBuffer
    '+-- xlRange.WrapText = False
    
    '+-- Baris sementara, untuk melihat hasilnya.
    xlRange.Offset(ColumnOffset:=2).Value2 = vBuffer
    xlRange.Offset(ColumnOffset:=2).WrapText = False
End Sub

Contoh terlampir... :)

Demikian, semoga sesuai.

Mbak @anggun123 ...

Script tersebut tetap berfungsi meskipun dalam 1 baris terdapat lebih dari 1 pola yang sama. Namun, saya tidak yakin dengan contoh URL yang mbak berikan, apakah benar demikian bentuk asalnya? Karena dengan contoh URL yang mbak berikan, polanya yang saat ini digunakan tidak akan ada yang cocok (match). Contohnya pada pola berikut:

([a-z]+://[a-z a-z 0-9.-]+)[^ ]*

notasi [a-z]+:// sederhananya dapat dipahami sebagai :

sekumpulan huruf yang selanjutnya diikuti oleh karakter ://

Jadi, notasi [a-z]+:// cocok untuk kata ftp:// atau http:// atau https:// atau stp:// atau ngaco:// dan sebagainya.

Sehingga pada URL (string) :

https: shopee.co.id  BK096 Tempat Kantong ...

prosesnya menjadi gagal karena pola yang ditentukan tidak ada yang sesuai.

Pertanyaan saya, apakah benar URL yang akan diproses seperti berikut ini :

https: shopee.co.id  BK096 Tempat Kantong Sampah Pampers Bekas Baby Diapers Dispenser Bag i.6044558.1113076034
https: shopee.co.id  BK112 Penguin Tempat Kantong Popok Bekas Portable Diaper Bag Dispenser i.6044558.1829035710

Mungkin bisa mbak pastikan kembali...

Mbak @anggun123 ...

Kalau kasusnya demikian, silahkan dicoba file terlampir. Polanya saya ubah menjadi :

'+-- Pola kata yang akan dicari.
vPattern = Array( _
    "(http(s|):(\/\/(([a-z0-9.-\/])+)[^ \n\r]*| .(([a-z0-9. ])+(\d)+\.(\d)+)))", _
    "Rp.([0-9 .,]+)|WA(:[0-9]+| .*[0-9])")

Cuma ada satu pertanyaan saya,

'+-- untuk menghapus tanda titik , jadi saya tambahkan kode ini
xlRange.Select
Selection.Replace What:=".", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

tujuannya apa? Pada dasarnya, jika hanya ingin menghilangkan tanda titik, cukup pada saat proses pengulangan (looping) dari array range tersebut. Misalkan saja, jika ingin menghilangkan tanda titik sebelum proses Regex, maka pada baris berikut :

'+-- Pengulangan untuk setiap data.
For lIdx = LBound(vBuffer) To UBound(vBuffer)
    sText = vBuffer(lIdx, 1)
    ...
Next

dapat diubah menjadi :

'+-- Pengulangan untuk setiap data.
For lIdx = LBound(vBuffer) To UBound(vBuffer)
    sText = Replace(vBuffer(lIdx, 1), ".", "")
    ...
Next

atau jika jika ingin menghilangkan tanda titik setelah proses Regex, maka pada baris berikut :

'+-- Salin ulang data.
vBuffer(lIdx, 1) = sText

dapat diubah menjadi :

'+-- Salin ulang data.
vBuffer(lIdx, 1) = Replace(sText, ".", "")

Demikian.