Replace kondisi tertentu

  1. 6 bulan yang lalu

    Siang kakak
    Siang master om @Caton

    Izin bertanya ,, apa bisa jika kita ingin replace suatu kata,,, dan kata disampingnya ikut keambil juga

    Contoh begini :

    Di kolom A .. ada sebuah kalimat "WA:08888882123"

    ketika kita replace cukup dengan kata kunci WA,, maka angka disebalahnya ikut juga ..
    Jadi targetnya adalah menghapus "WA:08888882123"

    Note : karena untuk angkanya dinamis,,

    Terima kasih

  2. Caton

    Jun 21 Terverifikasi Indonesia + 17.741 Poin

    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.

  3. maaf om @Caton

    maksudnya begini :

    ketika kita replace cukup dengan kata kunci WA,, maka angka disebalahnya ikut juga ..
    Jadi targetnya adalah menghapus "WA:08888882123"

    jadi replacenya adalah di Hapus :)

    seperti pada contoh lampiran dibawah ini

  4. Caton

    Jun 21 Terverifikasi Indonesia + 17.741 Poin

    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.

  5. Terima kasih banyak om @Caton uda berhasil,,
    izin bertanya untuk angka 10 itu kode untuk apa yaa om,, karena sya coba ganti dengan angka 1 dan lain2,,, tidak ada ngaruh dalam artian masih sama bisa berhasil...

    dan seumpama 2 kondisi seperti ini
    " Pemesanan partai, bisa mengubungi WA:0812345666666 dan dapatkan harga spesial hanya Rp.55000"

    kira2 edit gimana yaa om supaya
    WA:0812345666666 terhapus
    Rp.55000 terhapus

    sebelumnya saya ucapkan terima kasih atas ilmunya

  6. Caton

    Jun 21 Terverifikasi Indonesia + 17.741 Poin
    Di sunting 6 bulan yang lalu oleh Caton

    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.

  7. Terima kasih banyak om @Caton atas bantuan serta penjelasan detailnya

  8. 5 bulan yang lalu

    maaf om @Caton ada yg tertinggal :D

    Kalau seumpama 3 kondisi seperti ini gmn yaa om

    " untuk pemesanan https://abc.com/133296332.9215819272.blblabla
    bisa mengubungi WA:0812345666666 dan dapatkan harga spesial hanya Rp.55000"

    kira2 edit gimana yaa om supaya
    WA:0812345666666 terhapus
    Rp.55000 terhapus
    https://abc.com/133296332.9215819272.blblabla terhapus

    note : untuk URL kata kuncinya adalah https:// atau http://

    sebelumnya saya ucapkan terima kasih atas bantuannya

  9. Caton

    Jun 22 Terverifikasi Indonesia + 17.741 Poin

    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.

  10. terima kasih om @Caton

  11. maaf om @Caton mau tanya

    ketika ada 2 url / lebih , yg terhapus hanya 1 url saja,,,

    contoh url 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

    yg saat ini saya utak atik skripnya menjadi seperti ini

    'untuk menghapus tanda titik
            xlRange.Select
            Selection.Replace What:=".", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        
        '+-- Konversi range ke array.
        vBuffer = xlRange
            
        '+-- Pola kata yang akan dicari.
        vPattern = Array( _
            "([a-z]+://[a-z a-z 0-9.-]+)[^ ]*", _
            "([a-z]+:// [a-z a-z 0-9.-]+)[^ ]*", _
            "([a-z]+: [a-z a-z 0-9.-]+)[^ ]*", _
            "([a-z]+:[a-z a-z 0-9.-]+)[^ ]*", _
            "WA.(-?\d*\.?\d+){10}", _
            "(Rp.[0-9]*)", _
            "(Harga [0-9]*)" _
        )

    kira2 edit dimananya lagi yaa om supaya bisa 2 kondisi url yg terhapus

  12. Caton

    Jun 26 Terverifikasi Indonesia + 17.741 Poin

    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...

  13. benar om @Caton :)

    Berikut saya lampirkan data nya beserta script yg sudah saya sesuaikan

  14. Caton

    Jun 26 Terverifikasi Indonesia + 17.741 Poin

    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.

  15. Terima kasih om @Caton

    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 :

    hehe iya om ,,, yang saya tau hanya dengan me replace dengan cara diatas :D

    Terima kasih banyak om atas ilmunya

 

atau Mendaftar untuk ikut berdiskusi!