Automatische Links setzen aus Datenbestand

[killerspots]

Hallo zusammen,

ich bin auf der Suche nach einem kleinen Tool, welches mir automatisch Links setzt.
Ich habe hierzu einen Datenbestand (siehe Tabelllenblatt "Daten" in Beispiel-Excel anbei).


  Excel-URL-skript.xlsx (Größe: 9,56 KB / Downloads: 6)

Ich möchte nun, dass im Tabellenblatt ZIEL die Daten in der Spalte A "Kennzeichen" automatisch verlinkt werden mit der zugehörigen URL aus dem Datenblatt in Spalte B.
Ich denke, dass man den Abgleich gut mit einem SVerweis machen könnte, ich weiß nur nicht, wie ich die automatische Verlinkung umsetzen könnte.
Hat jemand vielleicht eine Idee und kann mir hierbei weiterhelfen?

Besten Dank,
Paul

[Mase]

Hi,

wenn Ich es richtig verstanden habe; schreibe mal folgendes in Ziel!B2:
=HYPERLINK(SVERWEIS(A2;Daten!$A$2:$B$6;2;0);A2)


Hinweis:
Am Ende steht A2. Dort könnte auch "2019-0903-042" stehen.

[killerspots]

Top, das hilft schon mal ganz hervorragend und tut genau das, was es soll.
Aber, ich würde das gerne ohne ein zusätzliche Hilfespalte machen müssen. Heißt, ich würde dies gern direkt in Spalte A1 im Tabellenblatt ZIEL haben. Denke, dass es dann vermutlich über ein Skript laufen muss, oder?
Kann mir hierbei jemand zur Hand gehen?

Danke und beste Grüße
Paul

[Mase]

Gerne.

VBA geht auch.

Doch wozu?
Blende Spalte A einfach aus.

[killerspots]

Gerne.

VBA geht auch.

Doch wozu?
Blende Spalte A einfach aus.

Klar ginge das auch. Ich möchte nur in meiner eigentlichen Haupttabelle, in der ich diese FUnktion nutzen möchte, nicht mit ausgeblendeten Spalten arbeiten. Daher die Hoffnung auf VBA.

Tausend Dank,
Paul

[00202]

Hallo Paul, :19:

dann so: :21:
[attachment=26582]

[Mase]

Moin,

anbei ein Vorschlag:

Code:

Option Explicit

Const m_Quelle As String = "Daten"
Const m_Ziel As String = "Ziel"

Function getLink(ByVal s As String, sSuchWert As String) As Variant
    On Error GoTo err
    getLink = Split(s, sSuchWert)(1): Exit Function
err:
If err.Number <> 0 Then getLink = err.Description
End Function

Sub FindAndSetLink2Cell()
    Dim wksQ As Worksheet
    Dim wksZ As Worksheet
    Dim rngQ As Range, rngFound As Range, rngZ As Range, c As Range
    '
    Set wksQ = ThisWorkbook.Worksheets(m_Quelle)
    Set wksZ = ThisWorkbook.Worksheets(m_Ziel)
    Set rngQ = wksQ.UsedRange.Columns(1).Cells
    Set rngZ = wksZ.UsedRange.Columns(1).Cells
    Set rngZ = Intersect(rngZ, rngZ.Offset(1, 0))
    '
    For Each c In rngZ
        Set rngFound = rngQ.Find(c.Value)
            If Not rngFound Is Nothing Then
                c.Offset(0, 1).FormulaLocal = "=Hyperlink(" & Chr(34) & getLink(rngFound.Offset(0, 1), "//") & Chr(34) & ";" & Chr(34) & c.Value & Chr(34) & ")"
            End If
    Next
    '
    Set rngQ = Nothing: Set rngZ = Nothing: Set rngZ = Nothing: Set rngFound = Nothing
    Set wksQ = Nothing: Set wksZ = Nothing:
End Sub

[killerspots]

Hallo Paul, :19:

dann so: :21:

Top, vielen Dank.
Nur zum Interesse: Kannst du mir das Skript kurz erklären? Ich versuche mich gerade in VBA etwas hinein zu arbeiten und entsprechend hilfreich sind Erläuterungen zu solchen.

[00202]

Hallo Paul, :19:

hier der Code mit Kommentaren: :21:

Code:

Option Explicit
Public Sub Main()
    ' Variablendeklaration
    Dim lngRow As Long
    ' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
    On Error GoTo Fin
    ' Der Code bezieht sich auf ein bestimmtes Objekt
    ' Hier das Objekt Tabelle1 (CodeName des Tabellenblattes
    ' Alles was sich auf dieses "With" bezieht
    ' MUSS mit einem Punkt beginnen
    With Tabelle1
        ' Bestimme die letzte belegte Zelle in Spalte A
        lngRow = Application.Max(1, .Cells(.Rows.Count, 1).End(xlUp).Row)
        ' Schleife von Zelle 2 bis Ende
        For lngRow = 2 To lngRow
            ' Erstelle den Hyperlink mit EVALUATE
            ' Mit Evaluate kann ich das Ergebnis einer Formel - hier Sverweis - einer Variablen zuordnen ODER direkt nutzen
            ' siehe: http://vbanet.blogspot.com/2018/05/formeln-auf-einer-userform-in-einer.html
            ' Und: http://vbanet.blogspot.com/2012/12/formeln-auch-array-per-vba-eintragen.html
            .Cells(lngRow, 1).Hyperlinks.Add Anchor:=.Cells(lngRow, 1), Address:=.Evaluate("=VLOOKUP(A" & lngRow & ",Daten!$A$2:$B$6,2,0)"), TextToDisplay:=.Cells(lngRow, 1).Value
        Next lngRow
    End With
Fin:
    ' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
    If err.Number <> 0 Then MsgBox "Fehler: " & err.Number & " " & err.Description
End Sub

Um dir die Arbeitsweise von Evaluate zu zeigen - bezogen auf deine Beispieldatei:

Code:

Option Explicit
Public Sub Main_1()
    Dim strTMP As String
    strTMP = Tabelle1.Evaluate("=VLOOKUP(A2,Daten!$A$2:$B$6,2,0)")
    MsgBox strTMP
End Sub

[Mase]

@Case:

Wie würdest Du diese Anweisung vervollständigen

Code:

Select Case WarumkommstDuStetsMitSoWenigZeichenAus