Hücrenin içindeki bir kelimeden sonrasını silme

[iaslan517]

Merhabalar,

Öncelikle iyi bayramlar. Elimde birleştirilmiş hücrelerden oluşan bir excel var. Bu hücrelerin içinde örneğin " Paketleme (1,23 AF) (1,45) [4,6]" şeklinde yazılar var. Tüm sayfayı taratıp örneğin " Paketleme (1,23 AF)" kalacak şekilde F)... sonrasını silebilecek makro yazabilmemiz mümkün mü?

 

[askm]

Örnek dosya eklerseniz yardımcı olalım.

 

[antonio]

Sub kelimelerden_paca_al()
Dim z As Object, alan As Range, hcr As Range, veri As Object
Set z = CreateObject("vbscript.regexp")
z.Global = True
z.Pattern = "Paketleme.*\)"
[COLOR="Blue"][B]Set alan = Sayfa1.Range("A2:A12,D2:D12")[/B][/COLOR] [COLOR="Red"][B]'Ben örnek olarak yazdım. Siz kelimelerin bulunduğu alanları buraya yazmalısınız.[/B][/COLOR]
On Error Resume Next
For Each hcr In alan
    Set veri = z.Execute(hcr)
    hcr.Value = veri(0)
Next hcr
MsgBox "İşlem tamamlandı.", vbInformation, "KELİME AYIKLAMA İŞLEMİ"
Set veri = Nothing
Set z = Nothing
End Sub

 

[iaslan517]

hocam, ekte örneği verdim. mevcut ve istenen diye. sadece ....F) ten sonrasını silecek

 

[Ömer BARAN]

Merhaba.

Aşağıdaki kod da işinizi görür.
Gerçek belgenizdeki veri alanı adresine göre kırmızı kısımları düzenlersiniz.
.

[B]Sub AYIKLA()[/B]
Set m = Sheets("MEVCUT")
For Each brn In m.Range("[SIZE="4"][B][COLOR="Red"]B7:B39[/COLOR][/B], [COLOR="red"][B]H7:H78[/B][/COLOR][/SIZE]")
    If Len(brn.Value) <> Len(Replace(brn.Value, "F)", "")) Then _
        brn.Value = Mid(brn.Value, 1, WorksheetFunction.Search("F)", brn.Value, 1) + 1)
    Next
[B]End Sub[/B]

 

[antonio]

hocam, ekte örneği verdim. mevcut ve istenen diye. sadece ....F) ten sonrasını silecek

Örnek dosyanıza göre kodları aşağıdaki şekilde düzenledim:

Sub ARA_BUL_YAZ()
Dim sh As Worksheet, z As Object, alan As Range, hcr As Range, yeni As String

Set z = CreateObject("vbscript.regexp")
z.Global = True
z.Pattern = "(?=\)).*$"
Set sh = Sheets("MEVCUT")
Set alan = sh.Range("B7:B39, H7:H78")
On Error Resume Next
For Each hcr In alan
    yeni = z.Replace(hcr.Value, ")")
    hcr.Value = yeni
Next hcr
MsgBox "İşlem tamamlandı.", vbInformation, "KELİME AYIKLAMA İŞLEMİ"
Set z = Nothing
End Sub