- den öncesini sil

[monopol]

arkadaşlar merhaba,

benim listemde D sütununda

152465-AYŞE
8465-FATMA
945412663211-ALİ gibi hücreler var. ben bu - ve onun önündeki sayıları nasıl silip sadece
AYŞE
FATMA
ALİ

yazmasını sağlayabilirim?

 

[Seyit Tiken]

Sub sil()
[d1:d1000].Replace What:="*-", Replacement:=""
End Sub

 

[Orion1]

Aşağıdaki kodlar işiniz görür.

Sub tireSil()
Dim i As Long
For i = 1 To Cells(65536, "D").End(xlUp).Row
On Error Resume Next
Sil = Split(Range("D" & i), "-")
Range("D" & i) = Sil(1)
Next
End Sub

 

[monopol]

yardımlarınız için teşekkürler,
ancak sadece rakam varsa silmesini istiyorum ben,
bu mümkün mü acaba.

Sub sil()
[d1:d1000].Replace What:="*-", Replacement:=""
End Sub

bu makroyu kullandım.

 

[Zeki Gürsoy]

Bu durumda şunu uygulayın.

Sub tireSil2()
' Evren
For Each rng In Range("D1:D" & Cells(65536, "D").End(xlUp).Row)

On Error Resume Next

sil = Split(rng, "-")

If IsNumeric(sil(0)) Then
    rng.Value = sil(1)
End If

Next

End Sub

 

[monopol]

olmadı. hata da vermedi.

 

[Zeki Gürsoy]

rng = Sil(1) satırını, rng.Value = sil(1) olarak değiştirin.

 

[ziya]

Merhaba,
Bu forumdan aldığım bir (Sn Ali'den) uygulama. (Mübarek fonk. değil, silgi)
=YERİNEKOY(YERİNEKOY(B7;SOLDAN(B7;TOPLA.ÇARPIM((UZUNLUK(B7)-UZUNLUK(YERİNEKOY(B7;{"-";0;1;2;3;4;5;6;7;8;9};"")))));"");"-";"")

Selamlar,

 

[Necdet]

Tire öncesi rakamsa Sil

Merhaba,

Evren Bey'in kodları, Zeki Bey'in de değişikliğinin üzerine aşağıdaki kodlar oluştu. Dener misiniz?

Sub TireOncesiSil()
On Error Resume Next
For i = 1 To [D65536].End(3).Row
    Dizi = Split(Cells(i, "D"), "-")
    If IsNumeric(Trim(Dizi(0))) = True Then Cells(i, "D") = Trim(Dizi(1))
Next
End Sub

 

[monopol]

günaydın,

yardımlarınız için çok teşekkür ederim.

Necdet Bey, uyguladığınız kodlar oldu.
Tekrardan teşekkür ederim.

 

[cem7110]

Arkadaşlar merhaba

BRAZIL,BR,aboutcampos.com,"CAMPOS, IVAN","CAMPOS, IVAN",ivan.campos@bra.xerox.com,"Av. Andre Araujo, 1032 apto.101A, MANAUS, AMAZONAS 069060000",5592 631 0126,5592 615 1014
BRAZIL,BR,aboutfurnaces.com,Bruno Hoppe,"Hoppe, Bruno",bhoppe@conex.com.br,"Rua Felix da Cunha,739, Floresta Porto Alegre, RS 90570-001",55 (051) 222 7544,
BRAZIL,BR,aboutmigrationbrazil.com,OVERSEAS CONSULTORIA SC LTDA,OVERSEAS CONSULTORIA SC LTDA,overseas@overseasconsult.com.br,"Av Dr Vieira de Carvalho 40 6 andar, SAO PAULO, SAO PAULO 01210010",55 11 2211799,55 11 2211799



gibi satırlardan oluşan tablolarda sadece mail adreslerini nasıl çekebilirim ?

Saygılarımla, teşekkürler.

 

[Murat OSMA]

Merhaba Cem Bey,

Satırların A sütununda olduğunu varsayarak, mailleri B sütununa alacak şekilde şu kodları önerebilirim;

Sub Mail_Ayir()
    Dim Reg As Object
    Dim Evn As Range
    Application.ScreenUpdating = False
    Range("B1:B100").ClearContents
    Set Reg = CreateObject("VBScript.RegExp")
    Reg.Global = True
    Reg.Pattern = "[a-z-0-9]*(@\D*)m"
    For Each Evn In Range("A1:A20")
        Set say = Reg.Execute(Evn.Value)
        If say.Count > 0 Then
           Evn.Offset(0, 1).Value = Reg.Execute(Evn.Value).Item(0)
        End If
    Next Evn
    Set Evn = Nothing: Set Reg = Nothing
End Sub

 

[yasin2y]

Merhaba
2 yol öneririm :
1. Yol :
çözmek istediğiniz cümleleri yan tarafa alt alta kopyalayın.
hucreleri seçin
Veri-Metni sütunlara dönüştür seçeneğinde "sınırlı" seçiminden "virgül" sekmesini işaretleyin ve devam edin.
Cümlede virgülle ayrılmış tüm karakterler yan yana hücrelere ayrılacaktır.

2. Yol: Makro

Sub mailbul()
Dim alan As Range

Dim mailadresi As Variant

sons = Cells(100000, 1).End(xlUp).Row
Set alan = Range("A1:A" & sons)

For celo = 1 To sons
Cells(celo, 2).ClearContents

With Cells(celo, 2).Interior
.PatternColorIndex = xlAutomatic
.TintAndShade = 0
.Color = 49407 '65535
.PatternTintAndShade = 0
End With
Next celo
'MsgBox "----"
For satir = 1 To sons
cumle = alan(satir)




uzun = Len(Cells(satir, 1))
If uzun = 0 Then GoTo devam1


'MsgBox satir & ". satirda arama yapılıyor. " & Chr(10) & _
satir & ". satirdaki hucrenin karakter sayisi = " & uzun & Chr(10) & _
" Alan : " & cumle

For s = 1 To uzun

kar = Mid(cumle, s, 1)


If kar <> "@" Then GoTo devam2

For geri = s To 1 Step -1
If Mid(cumle, geri, 1) = "," Then GoTo ileri
Next geri
'MsgBox "@ işareti var ama öncesinde virgül yok": 'GoTo devam1

ileri:
For ileri = s To Len(cumle)
If Mid(cumle, ileri, 1) = "," Then GoTo mesaj
Next ileri
'MsgBox "@ işareti var ama sonrasında virgül yok":
GoTo mesaj


devam2:
Next s

GoTo devam1

mesaj:
mailadresi = Mid(cumle, geri + 1, (ileri - geri - 1))
Cells(satir, 2).Value = mailadresi

Cells(satir, 2).Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With

devam1:
Next satir

Range("A1").Select
MsgBox " İŞLEM TAMAMLANMIŞTIR"
End Sub

 

[yyhy]

Arkadaşlar iyi günler, forumdaki konuları takip ediyoruz. Arkadaşların atmış olduğu örnek dosyaları ve konulürı beğeni ile takip ediyoruz. 9. mesajdaki ekli dosyayı indiremiyorum acaba bizde mi bir sorun var?

 

[Zeki Gürsoy]

Arkadaşlar iyi günler, forumdaki konuları takip ediyoruz. Arkadaşların atmış olduğu örnek dosyaları ve konulürı beğeni ile takip ediyoruz. 9. mesajdaki ekli dosyayı indiremiyorum acaba bizde mi bir sorun var?

Evet, bir sıkıntı var ancak Necdet bey VBA kodunu da vermiş zaten. İyi de etmiş. Dosya uçar kod kalır...