Ekstraksi Karakter Tertentu dan Contoh Penggunaan dengan VBA Tiga Kali

Sub SorotSel()
    Dim cell As Range
    For Each cell In Selection
        If InStr(cell.Value, "string tertentu") > 0 Then
            cell.Interior.Color = vbYellow
        End If
    Next cell
End Sub

Sub SalinDataSesuai()
    Dim lembarAsal As Worksheet
    Dim lembarTujuan As Worksheet
    Dim barisTerakhir As Long
    Dim barisSesuai As Long
    Set lembarAsal = ThisWorkbook.Sheets("Nama lembar asal")
    Set lembarTujuan = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    lembarTujuan.Name = "Data Ekstrak"
    barisTerakhir = lembarAsal.Cells(lembarAsal.Rows.Count, "A").End(xlUp).Row
    barisSesuai = 1
    For i = 1 To barisTerakhir
        If lembarAsal.Cells(i, 1).Value = "kriteria tertentu" Then
            lembarAsal.Rows(i).Copy Destination:=lembarTujuan.Rows(barisSesuai)
            barisSesuai = barisSesuai + 1
        End If
    Next i
End Sub

Sub KlasifikasiData()
    Dim cell As Range
    Dim rentangKategori As Range
    Set rentangKategori = ThisWorkbook.Sheets("Lembar Kategori").Range("A1:A10") ' Rentang yang mencantumkan kategori
    For Each cell In Selection
        For Each kat In rentangKategori
            If InStr(cell.Value, kat.Value) > 0 Then
                cell.Offset(0, 1).Value = kat.Value
                Exit For
            End If
        Next kat
    Next cell
End Sub