Excel Forum


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama



Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 25-11-2008, 18:36   #1
By_AbbA
 
Giriş: 31/03/2008
Şehir: Konya
Mesaj: 5
Excel Vers. ve Dili:
2002
Varsayılan Cümle içinden e-mail adreslerini almak

Mustafa (by_abba@hotmail.com);
musti01977@hotmail.com (musti01977@hotmail.com);
müslüman (cihadi-ekber@hotmail.com);
Nuray (nuraydogan24@hotmail.com);

A sütünün listesi ve liste uzayıp gidiyor. Burada benim yapmak istedigim şey şu () arasında kalan email adreslerini almak. parantezler dahil, diger kısımların silinmesi gerekiyor. bunun niçin nasıl kodlama gerekiyor.
Yardımcı olan arkadaşlara şimdiden teşekkürler...
By_AbbA Çevrimdışı   Alıntı Yaparak Cevapla
Eski 25-11-2008, 18:59   #2
Kemal Demir
 
Kemal Demir kullanıcısının avatarı
 
Giriş: 29/07/2004
Mesaj: 2,113
Varsayılan

İyi akşamlar,

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub SıfırlamaYap()
For x = 2 To [a65536].End(3).Row
uzunluk = Len(Cells(x, 1))
For k = 1 To uzunluk
If Left(Cells(x, 1), 1) = "(" Then
Else
Cells(x, 1) = Right(Cells(x, 1), uzunluk - k)
End If
say = Len(Cells(x, 1)) - 1
If Right(Cells(x, 1), 1) = ";" Then
Cells(x, 1) = Left(Cells(x, 1), say)
End If

Next
Next

End Sub
Yukarıdaki kod zannedersem işinizi görür.
__________________
Atatürk, başı dumanlı doruklarda yüce bir dağ tepesidir. Siz O'na yaklaştıkça o yükselir ve aranızdaki mesafe sonsuza değin aynı kalır.Devirlerinde büyük gözüken, zamanla küçülen benzerlerinden farkı budur ve böyle kalacaktır.

(Arriba Gazetesi, Portekiz, 1938)
Kemal Demir Çevrimdışı   Alıntı Yaparak Cevapla
Eski 25-11-2008, 22:34   #3
By_AbbA
 
Giriş: 31/03/2008
Şehir: Konya
Mesaj: 5
Excel Vers. ve Dili:
2002
Varsayılan

Kemal teşekkür ederim. Kırmızı ile yazılmış yeri 1 yaptıgımızda A1 hücresinden başlayıp tüm parantez dışında kalan kısımları gayet güzel siliyor.

Biraz daha kafa yorsak ( ve ) sildirmemizin bir yolu varmı?

Sub SıfırlamaYap()
For x = 1 To [a65536].End(3).Row
uzunluk = Len(Cells(x, 1))
For k = 1 To uzunluk
If Left(Cells(x, 1), 1) = "(" Then
Else
Cells(x, 1) = Right(Cells(x, 1), uzunluk - k)
End If
say = Len(Cells(x, 1)) - 1
If Right(Cells(x, 1), 1) = ";" Then
Cells(x, 1) = Left(Cells(x, 1), say)
End If

Next
Next

End Sub
By_AbbA Çevrimdışı   Alıntı Yaparak Cevapla
Eski 25-11-2008, 23:14   #4
tahsinanarat
Altın Üye
 
Giriş: 14/03/2005
Şehir: İstanbul
Mesaj: 1,368
Excel Vers. ve Dili:
Ofis 2003 Türkçe
Varsayılan

Sub ayir()
On Error Resume Next
Dim sonsat As Long, i As Long, ilk As Byte, son As Byte, uzunluk As Byte
sonsat = Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
For i = 1 To sonsat
ilk = WorksheetFunction.Find("(", Cells(i, "A").Value) + 1
son = WorksheetFunction.Find(")", Cells(i, "A").Value)
uzunluk = son - ilk
sonuc = Mid(Cells(i, "A").Value, ilk, uzunluk)
Cells(i, "A").Value = sonuc
Next
End Sub


Cells(i, "A").Value = sonuc satırındaki "A" harfini "B" yaparsan ayıklanmış halini B sutununa atar.
Kolay gelsin.
tahsinanarat Çevrimdışı   Alıntı Yaparak Cevapla
Eski 25-11-2008, 23:24   #5
By_AbbA
 
Giriş: 31/03/2008
Şehir: Konya
Mesaj: 5
Excel Vers. ve Dili:
2002
Thumbs up

Süper bir makro...
Çok teşekkür ettim.
By_AbbA Çevrimdışı   Alıntı Yaparak Cevapla
Eski 25-11-2008, 23:34   #6
Kemal Demir
 
Kemal Demir kullanıcısının avatarı
 
Giriş: 29/07/2004
Mesaj: 2,113
Varsayılan

tahsinararat,

Gayet başarılı bir çalışma.Aklıma gelmemişti.Tekrar tebrikler.

Yukarıdaki kod'un yanına başkabir kod yazmak biraz abest kaçar.
__________________
Atatürk, başı dumanlı doruklarda yüce bir dağ tepesidir. Siz O'na yaklaştıkça o yükselir ve aranızdaki mesafe sonsuza değin aynı kalır.Devirlerinde büyük gözüken, zamanla küçülen benzerlerinden farkı budur ve böyle kalacaktır.

(Arriba Gazetesi, Portekiz, 1938)
Kemal Demir Çevrimdışı   Alıntı Yaparak Cevapla
Eski 26-11-2008, 08:32   #7
Ali
 
Ali kullanıcısının avatarı
 
Giriş: 21/07/2005
Mesaj: 7,318
Excel Vers. ve Dili:
İş:Excel 2007-Türkçe Ev:Excel 2003-Türkçe
Varsayılan

Buda formüllü olsun.

Alternatif1

B1 hücresine

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
=PARÇAAL(A1;BUL("(";A1)+1;TOPLA(BUL({"(";")"};A1)*{-1;1})-1)
yazıp aşağı doğru çekiniz.

Alternatif2

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
=YERİNEKOY(DEĞİŞTİR(A1;1;MBUL("(";A1);"");");";"")
Ali Çevrimdışı   Alıntı Yaparak Cevapla
Eski 26-11-2008, 08:58   #8
Ali
 
Ali kullanıcısının avatarı
 
Giriş: 21/07/2005
Mesaj: 7,318
Excel Vers. ve Dili:
İş:Excel 2007-Türkçe Ev:Excel 2003-Türkçe
Varsayılan

Buda kullanıcı tanımlı fonksiyon

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
 
Function email(txt As String) As String
With CreateObject("VBScript.RegExp")
.Pattern = "[a-z0-9][a-z0-9_\.\-]+@[a-z0-9\-\.]+(\.[a-z]{2,3})+"
.IgnoreCase = True
If .test(txt) Then email = .Execute(txt)(0)
End With
End Function
Ali Çevrimdışı   Alıntı Yaparak Cevapla
Eski 26-11-2008, 09:59   #9
BirTürk
Destek Ekibi
 
Giriş: 06/09/2007
Şehir: KOCAELİ
Mesaj: 127
Excel Vers. ve Dili:
Excel 2003 TR
Varsayılan

Hücrede 00-1c-26-9c-6f-2c şeklinde veri var bunu - işaretinden kurtarmak için bu kodlardan yararlanabilirmiyiz

not : 00-1c-26-9c-6f-2c bu veriler MAC adresi

Bu mesaj en son " 26-11-2008 " tarihinde saat 10:08 itibariyle BirTürk tarafından düzenlenmiştir.... Neden: :) KÜÇÜK BİR YANLIŞLIK
BirTürk Çevrimdışı   Alıntı Yaparak Cevapla
Eski 26-11-2008, 10:18   #10
hsayar
 
hsayar kullanıcısının avatarı
 
Giriş: 02/03/2005
Şehir: İpsala/Edirne
Mesaj: 2,966
Excel Vers. ve Dili:
ev: Ofis 2007- Win Xp iş: Ofis 2010- Win Vista
Varsayılan

Alıntı:
BirTürk tarafından gönderildi Mesajı Görüntüle
Hücrede 00-1c-26-9c-6f-2c şeklinde veri var bunu - işaretinden kurtarmak için bu kodlardan yararlanabilirmiyiz

not : 00-1c-26-9c-6f-2c bu veriler MAC adresi
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Dim hcr As Range, sonsat as long, i as long
......
sonsat = Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
For i = 2 to sonsat
  Set hcr = Range("A:" & i)
  hcr = replace(hcr,"-","")
NEXt i 
set hcr = nothing
........
şeklinde kullanabilirsiniz
__________________
Felâket başa gelmeden evvel, onu önleyecek ve ona karşı savunulacak gerekleri düşünmek lâzımdır. Geldikten sonra dövünmenin faydası yoktur.[B]ATATÜRK[/B]

Türkler’den bahsediyorum. Düşmanına saldırırken amansız bir kasırgaya, korkunç bir denize ve insafsız bir yıldırıma benzeyen Türk; dost yanında ve silahsız düşman karşısında bir seher yelidir, berrak bir göldür. Gönül açan bu yeli yıldırmak, göz kamaştıran bu gölü coşkun bir denize çevirmek tabiatı da inciten bir gaflet olur.
[B]Tasso (İtalyan Şair)[/B]
hsayar Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 20:11


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.


Bahis Forum - Define - Çorlu Kamera - Çorlu Petek Temizleme - Site Yönetimi - TYPO3 Türkiye - 2015 Fuar - Çorlu Mimarlık - Çorlu Hotel - Rotary Web Sitesi
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden