Avatar uživatele
bolak

Jak udělat v excelu:

Mám ve sloupci „A“ na každém řádku nějaký text a mezi ním jsou emailové adresy a potřebuju aby mi v sousední buňce ve sloupci „B“ vyhodil jen tu emailovou adresu, a v případě že jich tam bude víc, tak všechny vedle sebe oddělené mezerou. Dokázal by si s tím někdo poradit?

Zajímavá 0 před 3772 dny Sledovat Nahlásit



Odpovědi
Avatar uživatele
a623682@drdr

jednoduse to nepujde

Zdroj: https://encryp­ted.google.com/#q=ex­cel+extract+e­mail+from+text

0 Nominace Nahlásit


Avatar uživatele
nonnel

Vyzkoušej tento prográmek. Nevím, jaké máš zkušenosti s VBA. Když tak napiš a já ti poradím, jak postupovat.

Sub EAdresy()
Dim ret$, rad&, radDo&, poz%, pozZ%, pozK%
' Z řetězce v buňkách A vybere emailovou adresu a zkopíruje ji do sloupce B
' POZOR! V textu nesmí být jiný zavináč, než ten v adresách.
For rad = 5000 To 1 Step –1
If Cells(rad, 1).Value <> "" Then radDo = rad: Exit For
Next rad
poz = 1
For rad = 1 To radDo
ret = Cells(rad, 1).Value
Cells(rad, 2).Value = ""
For poz = poz To Len(ret)
If Mid(ret, poz, 1) = „@“ Then
pozZ = poz + 1
pozK = pozZ
While Mid(ret, pozZ, 1) <> " "
pozZ = pozZ – 1
Wend
pozZ = pozZ + 1

N0:
Select Case Mid(ret, pozK, 1)
Case " "
pozK = pozK + 1
If pozK > Len(ret) Then GoTo N1
Case Else
pozK = pozK + 1
If pozK > Len(ret) Then pozK = pozK – 1: GoTo N1
GoTo N0
End Select

N1:
Cells(rad, 2).Value = Cells(rad, 2).Value & Mid(ret, pozZ, pozK – pozZ) & " "
poz = pozK
End If
Next poz
pozZ = 0: pozK = 0: poz = 1
Next rad
End Sub

Podmínkou je, že v textu ve sloupci A budou pouze zavináče (@), které patří adresám.
Doplňuji:
Začátek programu začíná řádkem Sub EAdresy() a končí End Sub

Upravil/a: nonnel

0 Nominace Nahlásit


Diskuze k otázce
Avatar uživatele
bolak

nonnel: budeš mě muset popostrčit, jednou už mi to tu sice někdo „ukazoval“, ale já už to zapomněl :) takže pěkně krůčej po krůčeji, buď tak hodný :)

před 3771 dny Odpovědět Nahlásit
Nový příspěvek
Zajímavé otázky v kategorii Počítače a internet