Clever-Excel-Forum

Seiten: 1 2

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).

[attachment=26575]

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

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.

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

Gerne.

VBA geht auch.

Doch wozu?
Blende Spalte A einfach aus.

(19.09.2019, 20:57)Mase schrieb: [ -> ]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

Hallo Paul, :19:

dann so: :21:
[attachment=26582]

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

(20.09.2019, 07:57)Case schrieb: [ -> ]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.

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

@Case:

Wie würdest Du diese Anweisung vervollständigen

Code:
Select Case WarumkommstDuStetsMitSoWenigZeichenAus

Seiten: 1 2

killerspots

Mase

killerspots

Mase

killerspots

Case

Mase

killerspots

Case

Mase