Karakter ayrıştırma ve silme

[igultekin2000]

Merhaba;
Daha önce formdan bulduğum karakter ayrıştırma ve silme makrosuna bir ilave daha yapmak istiyorum. Ancak yapamadım. Kullandığım makro

Private Sub AYIR_Click()


    'Haluk - 31/05/2019
    'ürünlerdeki isim ve fiyat ayrıştırması sağlıyor, isim kalıp fiyat siliniyor
    Dim objRegEx As Object, NoB As Long, myStr As String
   
    Set objRegEx = CreateObject("VBscript.RegExp")
    objRegEx.Global = True
    objRegEx.Pattern = "\([^()]*\)|(\-.*$)"
    NoB = Range("A" & Rows.Count).End(xlUp).Row
    For i = 3 To NoB
        myStr = Range("A" & i).Text
        myStr = objRegEx.Replace(myStr, "")
        Range("A" & i) = myStr
        myStr = Empty
    Next
    Set objRegEx = Nothing

End Sub

PAMUK İPLİĞİ (29,33 TL) trh:03.01.23) / PAMUK İPLİĞİ şeklindeki listedeki ürün ismi duruyor bunun dışındaki diğer bilgileri siliyordu. Ancak daha önce Parantez veya benzeri işaret kullanırken şimdi - trh: - kullanmaya başladım. Bu makroya nasıl bir ilave yapılırsa trh: ve tarih bilgisi de silinebilir. Ürün ismi SATEN PAMUKLU KUMAŞ vs gibi bir kaç cümle olabiliyor.

 

[Korhan Ayhan]

Bu veriden almak istediğiniz sonuç nedir? Farklı yapıda veri girişiniz var mı?

PAMUK İPLİĞİ (29,33 TL) trh:03.01.23) / PAMUK İPLİĞİ

 

[igultekin2000]

Verilerin tamamı bu şablon olarak giriliyor. Farklı bir veri girişi olmuyor.

 

[Korhan Ayhan]

Bir sorum daha vardı ona cevap vermemişsiniz.

 

[Haluk]

    objRegEx.Pattern = "\s?\(.*$"

.

 

[igultekin2000]

Sadece ürünün isminin kalması, belirttiğiniz gibi
PAMUK İPLİĞİ

 

[igultekin2000]

Teşekkür ederim, istediğim sonucu verdi.

 

[Korhan Ayhan]

İki alternatifte ben paylaşmak isterim.

Option Explicit

Sub Test_1()
    Dim X As Long, Data As Variant
   
    With VBA.CreateObject("VBscript.RegExp")
        .Global = True
        .Pattern = "(^\D+ )"
        For X = 3 To Cells(Rows.Count, 1).End(3).Row
            If .Test(Cells(X, 1).Value) And InStr(1, Cells(X, 1).Value, "(") > 0 Then
                Set Data = .Execute(Cells(X, 1).Value)
                Cells(X, 1).Value = Trim(Data(0))
            End If
        Next
    End With

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Sub Test_2()
    Dim X As Long
   
    For X = 3 To Cells(Rows.Count, 1).End(3).Row
        If InStr(1, Cells(X, 1).Value, "(") > 0 Then
            Cells(X, 1).Value = Trim(Split(Cells(X, 1).Value, "(")(0))
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[igultekin2000]

Teşekkür ederim;
iki makro da sorunsuz çalışıyor. İyi çalışmalar.