Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.10.2025 11:16:26
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Zellen mit gleichen Inhalten mit Pfeilen verbinden

Zellen mit gleichen Inhalten mit Pfeilen verbinden
Stef@n
Hallo Excel-Freunde,
mal eine für mich selber ungewöhnliche Frage ;)
Ich habe zwei Tabellen, die im Sheet nebeneinander stehen.
Einzelne Inhalte der Tabelle 1 sind auch in Tabelle 2 enthalten.
Diese jeweiligen Zellinhalte sollen mit einem Pfeil verbunden werden.
Wenn Zellinhalt a2 = d5 - Pfeil
Wenn Zellinhalt a5 = d1 - Pfeil
usw
Kann man so etwas realisieren ? VBA ?
Freu mich auf einen Tip
Gruß
Stef@n
Anzeige
AW: Zellen mit gleichen Inhalten mit Pfeilen verbinden
16.02.2011 12:59:15
Reinhard
Hallo Stefan,

Option Explicit
Sub check()
Dim ZeiA As Long, ZeiD As Long, Nr As Integer
Call Loesch
With Worksheets("Tabelle1")
For ZeiA = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
For ZeiD = 1 To .Cells(Rows.Count, 4).End(xlUp).Row
If .Cells(ZeiA, 1).Value = .Cells(ZeiD, 4).Value Then
MsgBox .Cells(ZeiA, 1).Value & " " & .Cells(ZeiD, 4).Value
Nr = Nr + 1
Call Pfeil(.Cells(ZeiA, 1), .Cells(ZeiD, 4), Nr)
End If
Next ZeiD
Next ZeiA
End With
End Sub
Sub Pfeil(rngA As Range, rngD As Range, ByVal Nr As Long)
Dim xA, yA, xD, yD
xA = rngA.Left + 20
yA = rngA.Top + 6
xD = rngD.Left + 20
yD = rngD.Top + 6
With Worksheets("Tabelle1")
.Shapes.AddLine(xA, yA, xD, yD).Name = "Pfeil" & Nr
With .Shapes("Pfeil" & Nr)
.Line.EndArrowheadStyle = msoArrowheadTriangle
.Line.EndArrowheadLength = msoArrowheadLengthMedium
.Line.EndArrowheadWidth = msoArrowheadWidthMedium
If yD 

Gruß
Reinhard
Anzeige
AW: Zellen mit gleichen Inhalten mit Pfeilen verbinden
16.02.2011 13:49:16
Stef@n
Hallo Reinhard,
coool ! Danke !
Klappt (fast) perfekt ! Er verbindet einige Zellen, obwohl die Inhalte nicht identisch sind
und es fehlen auch welche ...
Hier die Beispiel-Datei
https://www.herber.de/bbs/user/73582.xls
Kannst Du nochmal schauen ?
Evtl. die Pfeile auch durch Striche ersetzen ?
Besten Gruß
Stef@n
Anzeige
AW: Zellen mit gleichen Inhalten mit Pfeilen verbinden
16.02.2011 13:54:47
robert
Hi,
diese Zeile löschen oder auskommentieren wie gezeigt
'If yD < yA Then .Flip msoFlipVertical
gruß
robert
AW: Zellen mit gleichen Inhalten mit Pfeilen verbinden
16.02.2011 14:25:59
Stef@n
Hallo Robert,
na, den Fehler hatte ich jetzt selbst "produziert"
Funktioniert einwandfrei
Danke Dir sehr !
Besten Gruß
Stef@n
AW: Zellen mit gleichen Inhalten mit Pfeilen verbinden
16.02.2011 15:25:39
Reinhard
Hallo Stefan,
komisch, bei Tests brauchte ich irgendwie das Flip, aber okay, wenn es ohne geht.
Die Pfeilspitze habe ich jetzt entfernt.
Und auch die Berechnungen von Left und Top verändert. Left reagiert jetzt auf Spaltenbreiteänderung in A.
Option Explicit
Sub check()
Dim ZeiA As Long, ZeiD As Long, Nr As Integer
Call Loesch
With Worksheets("Tabelle1")
For ZeiA = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
For ZeiD = 1 To .Cells(Rows.Count, 4).End(xlUp).Row
If .Cells(ZeiA, 1).Value = .Cells(ZeiD, 4).Value Then
Nr = Nr + 1
Call Pfeil(.Cells(ZeiA, 1), .Cells(ZeiD, 4), Nr)
End If
Next ZeiD
Next ZeiA
End With
End Sub
Sub Pfeil(rngA As Range, rngD As Range, ByVal Nr As Long)
Dim xA, yA, xD, yD
xA = rngA.Offset(0, 1).Left
yA = rngA.Top + (rngA.Offset(1, 0).Top - rngA.Top) / 2
xD = rngD.Left + 1
yD = rngD.Top + (rngD.Offset(1, 0).Top - rngD.Top) / 2
With Worksheets("Tabelle1")
.Shapes.AddLine(xA, yA, xD, yD).Name = "Pfeil" & Nr
With .Shapes("Pfeil" & Nr)
'.Line.EndArrowheadStyle = msoArrowheadTriangle
.Line.EndArrowheadLength = msoArrowheadLengthMedium
.Line.EndArrowheadWidth = msoArrowheadWidthMedium
'If yD 

Gruß
Reinhard
Anzeige
Perfekt ! Danke ! OT
18.02.2011 09:55:49
Stef@n
;

Forumthreads zu verwandten Themen

Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige