Skip i'r prif gynnwys

Sut i drosi cyfeiriadau e-bost lluosog yn hyperddolenni yn Excel? 

Os oes gennych chi restr o gyfeiriadau e-bost testun plaen mewn taflen waith, ac nawr, rydych chi am drosi cyfeiriadau e-bost traethodau ymchwil yn hypergysylltiadau y gallwch chi anfon e-byst wrth glicio ar y cyfeiriadau. Wrth gwrs, gallwch eu trosi i gyfeiriadau e-bost hypergysylltiedig, ond, bydd y dull hwn yn ddiflas os oes angen trosi sawl cyfeiriad. Yn yr erthygl hon, byddaf yn siarad am rai triciau da i ddelio â'r dasg hon.

Trosi cyfeiriadau e-bost lluosog i hyperddolenni gyda Fformiwla

Trosi cyfeiriadau e-bost lluosog i hyperddolenni gyda chod VBA

swigen dde glas saeth Trosi cyfeiriadau e-bost lluosog i hyperddolenni gyda Fformiwla

Efo'r hyperlink swyddogaeth, gallwch drosi cyfeiriadau e-bost y golofn yn gyflym i gyfeiriadau hypergysylltiedig ar unwaith.

1. Rhowch y fformiwla hon = hyperddolen ("mailto:" & A2) mewn cell wag lle rydych chi am roi'r canlyniad, gweler y screenshot:

doc trosi cyfeiriadau i hyperddolenni 1

2. Yna llusgwch y ddolen llenwi i lawr i'r celloedd rydych chi am gynnwys y fformiwla hon, ac mae'r holl gyfeiriadau e-bost wedi dod yn hyperddolenni y gellir eu clicio fel y dangosir y screenshot canlynol:

doc trosi cyfeiriadau i hyperddolenni 2

swigen dde glas saeth Trosi cyfeiriadau e-bost lluosog i hyperddolenni gyda chod VBA

Fel y gallwch weld, trwy ddefnyddio'r fformiwla uchod, ychwanegir llinyn “mailto:” o flaen pob cyfeiriad e-bost, os nad ydych chi eisiau'r mailto: o fewn y cyfeiriadau, gall y cod VBA canlynol ffafrio chi.

1. Daliwch i lawr y Alt + F11 allweddi yn Excel, ac mae'n agor y Microsoft Visual Basic ar gyfer Ceisiadau ffenestr.

2. Cliciwch Mewnosod > Modiwlau, a gludwch y macro canlynol yn y Modiwlau Ffenestr.

Cod VBA: Trosi cyfeiriadau e-bost lluosog yn hyperddolenni

Sub EmailHylink()
'updateby Extendoffice
    Dim xRg As Range
    Dim xCell As Range
    Dim xAddress As String
    Dim xUpdate As Boolean
    On Error Resume Next
    xAddress = Application.ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select the data range", "Kutools for Excel", xAddress, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    xUpdate = Application.ScreenUpdating
    Application.ScreenUpdating = False
    For Each xCell In xRg
        xCell.Hyperlinks.Add Anchor:=xCell, Address:="mailto:" & xCell.Value
    Next
    Application.ScreenUpdating = xUpdate
End Sub

3. Ar ôl pasio'r cod, pwyswch F5 allwedd i'r cod hwn, a bydd blwch prydlon yn popio allan i'ch atgoffa i ddewis yr ystod ddata rydych chi am ei defnyddio, gweler y screenshot:

doc trosi cyfeiriadau i hyperddolenni 3

4. Ac yna cliciwch OK, mae'r holl gyfeiriadau e-bost a ddewiswyd wedi'u trosi i'r cyfeiriadau hypergysylltiedig, gweler y screenshot:

doc trosi cyfeiriadau i hyperddolenni 4

Offer Cynhyrchiant Swyddfa Gorau

Nodweddion Poblogaidd: Darganfod, Amlygu neu Adnabod Dyblygiadau   |  Dileu Rhesi Gwag   |  Cyfuno Colofnau neu Gelloedd heb Colli Data   |   Rownd heb Fformiwla ...
Super-edrych: VLookup Meini Prawf Lluosog  |   VLookup Gwerth Lluosog  |   VLookup Ar Draws Taflenni Lluosog   |   Edrych Niwlog ....
Rhestr gwympo Uwch: Creu Rhestr Gollwng yn Gyflym   |  Rhestr Gollwng Dibynnol   |  Rhestr Gollwng Aml-ddewis ....
Rheolwr Colofn: Ychwanegu Nifer Penodol o Golofnau  |  Symud Colofnau  |  Toglo Statws Gwelededd Colofnau Cudd  |  Cymharwch Ystodau a Cholofnau ...
Nodweddion dan Sylw: Ffocws ar y Grid   |  Golwg Dylunio   |   Bar Fformiwla Mawr   |  Rheolwr Llyfr Gwaith a Thaflen   |  Llyfrgell Adnoddau (Testun Auto)   |  Dewiswr Dyddiad   |  Cyfuno Taflenni Gwaith   |  Amgryptio/Dadgryptio Celloedd   |  Anfon E-byst trwy Restr   |  Hidlo Super   |   Hidlo Arbennig (hidlo mewn print trwm/italig/strikethrough...) ...
15 Set Offer Gorau:  12 Testun offer (Ychwanegu Testun, Dileu Cymeriadau,...)   |   50 + Siart Mathau (Siart Gantt,...)   |   40+ Ymarferol Fformiwlâu (Cyfrifwch oedran yn seiliedig ar ben-blwydd,...)   |   19 mewnosod offer (Mewnosod Cod QR, Mewnosod Llun o'r Llwybr,...)   |   12 Trosi offer (Rhifau i Eiriau, Trosi arian cyfred,...)   |   7 Uno a Hollti offer (Rhesi Cyfuno Uwch, Celloedd Hollt,...)   |   ... a mwy

Supercharge Eich Sgiliau Excel gyda Kutools for Excel, a Phrofiad Effeithlonrwydd Fel Erioed Erioed o'r blaen. Kutools for Excel Yn cynnig dros 300 o nodweddion uwch i hybu cynhyrchiant ac arbed amser.  Cliciwch Yma i Gael Y Nodwedd Sydd Ei Angen Y Mwyaf...

tab kte 201905

Office Tab Yn dod â rhyngwyneb Tabbed i Office, ac yn Gwneud Eich Gwaith yn Haws o lawer

  • Galluogi golygu a darllen tabbed yn Word, Excel, PowerPoint, Cyhoeddwr, Mynediad, Visio a Phrosiect.
  • Agor a chreu dogfennau lluosog mewn tabiau newydd o'r un ffenestr, yn hytrach nag mewn ffenestri newydd.
  • Yn cynyddu eich cynhyrchiant 50%, ac yn lleihau cannoedd o gliciau llygoden i chi bob dydd!
Comments (7)
No ratings yet. Be the first to rate!
kk.operator
kk.operator
This comment was minimized by the moderator on the site
Ich suche eine Formel mit der ich EMail-Adressen in URLs umwandeln kann...

Beispiel: > http://www.test.de

Kann mir jemand helfen?
Reply
0
0
skyyang
skyyang     kk.operator
This comment was minimized by the moderator on the site
Hello, kk.operator

To solve your problem, please apply the following code:

Sub EmailHylink()
'updateby Extendoffice
    Dim xRg As Range
    Dim yRg As Range
    Dim xCell As Range
    Dim xCell2 As Range
    Dim xAddress As String
    Dim xUpdate As Boolean
    Dim xRegEx As Object
    Dim arrSplit() As String
    
    On Error Resume Next
    xAddress = Application.ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select the data range", "Kutools for Excel", xAddress, , , , , 8)
    Set yRg = Application.InputBox("Please select the save range", "Kutools for Excel", xAddress, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    If yRg Is Nothing Then Exit Sub
    Set yRg = yRg.Range("A1").Resize(xRg.Rows.Count, xRg.Columns.Count)

    xUpdate = Application.ScreenUpdating
    Application.ScreenUpdating = False
    
    Set xRegEx = CreateObject("VBSCRIPT.REGEXP")
    With xRegEx
        .Pattern = "^\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*$"
        .Global = True
        .IgnoreCase = True
    End With
    
    For I = 1 To xRg.Rows.Count
        For J = 1 To xRg.Columns.Count
            Set xCell = xRg.Cells(I, J)
            Set xCell2 = yRg.Cells(I, J)
            If xRegEx.test(xCell.Value) Then
                arrSplit = Split(xCell.Value, "@")
                 If UBound(arrSplit, 1) = 1 Then
                    xCell2.Value = "http://www." & arrSplit(1)
                    xCell2.Hyperlinks.Add Anchor:=xCell2, Address:=xCell2.Value
                 End If
            End If
        Next
    Next
    Application.ScreenUpdating = xUpdate
End Sub


Please have a try, hope it can help you!
Reply
Report
0
0
DL
DL
This comment was minimized by the moderator on the site
Works perfectly in Excel 2003! Thanks much!
Reply
0
0
Katharine
Katharine
This comment was minimized by the moderator on the site
I'm in a MAC environment so don't have a ALT key. Any other ieas?
Reply
0
0
moranrd
moranrd     Katharine
This comment was minimized by the moderator on the site
The equivalent for the ALT key is the command key (located to the left of the Option Key).

Both of these keys are located to the left of the spacebar.
Reply
Report
0
0
Festus
Festus
This comment was minimized by the moderator on the site
you are a star, it worked perfectly. thanks a million
Reply
0
0
Mike Smith
Mike Smith
This comment was minimized by the moderator on the site
I cannot find the find converting cells to hyperlinks.
Reply
0
0
There are no comments posted here yet
Please leave your comments in English
Guest
Posting as Guest
×
Rate this post:
Reset
0   Characters
Suggested Locations