• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Uzun Metnin içinden kopyalamak

  • Konbuyu başlatan Konbuyu başlatan Mikdad
  • Başlangıç tarihi Başlangıç tarihi

Mikdad

Altın Üye
Katılım
5 Ocak 2006
Mesajlar
333
Excel Vers. ve Dili
365 Türkçe
Selamun Aleykum
Elimde eski veritabanımın Yedeği var.
sql i excelden açtım.üyelerime ait email adreslerine ihtiyacım var. a1 hucresinde örneğin

a1s4d5d1 'aaa@hotmail.com'kjhkjasd5a4dsasdnsda şeklinde satır var benim yapmak istediğim bir formul yazarak iki tane ' ' tırnak arasındaki metni başka bir hücreye kopyalamak. bu konuda yardımcı olur musunuz?
 
Merhaba.
Veriniz A1'de ise;
Kod:
=PARÇAAL([COLOR="Red"]A1[/COLOR];(BUL("'";[COLOR="Red"]A1[/COLOR];1))+1;(BUL("'";[COLOR="Red"]A1[/COLOR];BUL("'";[COLOR="Red"]A1[/COLOR];1)+1))-(BUL("'";[COLOR="Red"]A1[/COLOR];1))-1)
 
Merhabalar,
Alternatif;
Kod:
=PARÇAAL(A1;ARA(;-1/(PARÇAAL(PARÇAAL(A1;1;
  MBUL("@";A1));SATIR(A1:A38);1)="'");
    SATIR(A1:A38))+1;MBUL("'";A1&" ";
      MBUL("@";A1))-
    ARA(;-1/(PARÇAAL(PARÇAAL(A1;1;
  MBUL("@";A1));SATIR(A1:A38);1)="'");
SATIR(A1:A38))-1)

Hay marja!
 
Aşağıdaki kodu kullanabilirsiniz.
Kod:
Sub ayikla()
Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="'", Replacement:=" ' ", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    For x = 1 To [a65536].End(3).Row
    d = Split(Cells(x, 1))
        For Each elem In d
            If InStr(elem, "@") Then
                a = a + 1
                Sheets("sayfa2").Cells(a, 1) = Trim(Replace(Replace(Replace(elem, ",", ""), "e-mail:", ""), Chr(160), ""))
            End If
        Next elem
    Next x
    Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

        Sheets("sayfa2").Select
End Sub
 
Son düzenleme:
Allah Razı Olsun Değerli Hocalarım. Hepinizin Kodunu Teker Teker Denedim Hepsi de çalıştı. tekrar Teşekkür Ederim.
 
Geri
Üst