per Doppelklick Daten in separate Tabelle

Dieter · 2007-09-13T09:57:00+00:00

Hallo, ich verwalte meine Vorfahren in Excel und möchte per Doppelklick auf eine Zeile (einen Vorfahren) die Inhalte mehrerer Zeilen in einem separaten Tabellenblatt beliebig positionieren. Das knifflige dabei ist, dass ich die angeklickte Zeile und die Zeilen, die in der angeklickten Zeile in den Spalten F, G, H und I vermerkt sind, haben möchte. In meiner Beispieldatei möchte ich also bei Doppelklick auf die Nr "7" die Zeilen mit der Nr 7 und 14 und 15 und 3 und 2 (die im Beispiel rot markierten) im Zugriff haben. Hinweis : Mit Nr ist nicht die Excel-Zeilennummer gemeint, sondern der Wert in Spalte A. Die Excel-Zeilennummer muss also nicht mit der benötigten Nummer übereinstimmen ! https://www.herber.de/bbs/user/45987.xls Rudi hat mir gestern bereits mitteilen können, wie ich eine einzelne Zeile in eine separate Tabelle bekomme. Dies habe ich bereits in mein Beispiel-Excel-File eingebaut. Vielleicht kann man da aufbauen. Würde mich sehr freuen, wenn Ihr mir helfen könntet. Vielen Dank und Grüsse Dieter

Hallo Dieter,
ich hab den Code jetzt komplett umgestrickt. Die Hilfsberechnungen in den Spalten M bis Q in Tabelle1 sind nicht mehr erforderlich. Diese Werte berechnet das Makro jetzt selbst. Ich hab dafür die Function "Zeile" eingefügt, die mit der Methode "Find" die Zeilennummern zu den jeweiligen Nr. ermittelt.
Für die Ausgabe im "Stammblatt" habe ich eine kleine Subroutine geschrieben. Das ist pflegeleichter, als 6 mal den Übertragungscode in der Hauptroutine zu schreiben.
Gruß
Franz


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Ausgabe der Daten zur aktuellen Person in der angeklickten Zeile im Blatt "Stammblatt
Cancel = True
'aktuelle Person
Call Ausgabe(wksQuelle:=Me, wksZiel:=Worksheets("Stammblatt"), _
SpalteZiel:=2, ZeileQuelle:=Target.Row)
'Partner
Call Ausgabe(wksQuelle:=Me, wksZiel:=Worksheets("Stammblatt"), _
SpalteZiel:=3, ZeileQuelle:=Zeile(Cells(Target.Row, 6).Value))
'Vater
Call Ausgabe(wksQuelle:=Me, wksZiel:=Worksheets("Stammblatt"), _
SpalteZiel:=4, ZeileQuelle:=Zeile(Cells(Target.Row, 7).Value))
'Mutter
Call Ausgabe(wksQuelle:=Me, wksZiel:=Worksheets("Stammblatt"), _
SpalteZiel:=5, ZeileQuelle:=Zeile(Cells(Target.Row, 8).Value))
'Kind
Call Ausgabe(wksQuelle:=Me, wksZiel:=Worksheets("Stammblatt"), _
SpalteZiel:=6, ZeileQuelle:=Zeile(Cells(Target.Row, 9).Value))
'partner von
Call Ausgabe(wksQuelle:=Me, wksZiel:=Worksheets("Stammblatt"), _
SpalteZiel:=7, ZeileQuelle:=Zeile(Cells(Target.Row, 10).Value))
Sheets("Stammblatt").Activate
End Sub
Private Function Zeile(Nr As Variant) As Long
'Ermittelt Zeile zu Nummer der gesuchten Person
Dim Zelle As Range
Set Zelle = Me.Columns(1).Find(What:=Nr, LookIn:=xlValues, lookat:=xlWhole)
If Zelle Is Nothing Then Zeile = 0 Else Zeile = Zelle.Row
Set Zelle = Nothing
End Function
Sub Ausgabe(wksQuelle As Worksheet, wksZiel As Worksheet, SpalteZiel%, ByVal ZeileQuelle%)
'Trägt Daten der jeweiligen Person in wksZiel ein
With wksZiel
If ZeileQuelle > 0 Then
.Range(.Cells(2, SpalteZiel), .Cells(9, SpalteZiel)) = _
WorksheetFunction.Transpose(wksQuelle.Range(wksQuelle.Cells(ZeileQuelle, 1), _
wksQuelle.Cells(ZeileQuelle, 8)))
Else
'Inhalte im Bereich löschen, wenn keine Nr. zur Informationen vorhanden
.Range(.Cells(2, SpalteZiel), .Cells(9, SpalteZiel)).ClearContents
End If
End With
Set BlattQuelle = Nothing
Set BlattZiel = Nothing
End Sub

Hallo Dieter,
ich hab die Prozedur "Ausgabe" angepasst, so dass auch bestimmte Formatierungen (z.Zt. die Farbe von Zellhintergrund und Schrift) aus der Quelle in die Tabelle "Stammdaten übertragen werden.
Du muss den Wert der Variablen "lngZeile" von 2 auf den gewünschten Wert ändern, um die Ausgabe in einer anderen Zeile zu starten. Damit die Formatierungen im Ausgabebereich stimmen einfach den gesamten Bereich A1:G9 kopieren und an der gewünschten Position einfügen..
Gruß
Franz


Sub Ausgabe(wksQuelle As Worksheet, wksZiel As Worksheet, SpalteZiel%, ByVal ZeileQuelle%)
'Trägt Daten der jeweiligen Person in wksZiel ein
Dim Zelle As Range, iI%
'Startzeile in Zieltabelle
Const lngZeile As Long = 2
'StartSpalte in Quelle
Const iSpalte As Integer = 1
'Anzahl Spalten aus Quelle, die eingefügt werden sollen
Const iSpalten As Integer = 8
With wksZiel
If ZeileQuelle > 0 Then
'Werte übertragen
.Range(.Cells(lngZeile, SpalteZiel), .Cells(lngZeile + iSpalten - 1, SpalteZiel)) = _
WorksheetFunction.Transpose(wksQuelle.Range(wksQuelle.Cells(ZeileQuelle, iSpalte), _
wksQuelle.Cells(ZeileQuelle, iSpalte + iSpalten - 1)))
'Einzelne Zell-Formate übertragen
For iI = 1 To iSpalten
With .Cells(lngZeile, SpalteZiel).Offset(iI - 1, 0)
'Zellhintergrundfarbe
.Interior.ColorIndex = wksQuelle.Cells(ZeileQuelle, _
iSpalte).Offset(0, iI - 1).Interior.ColorIndex
'Zellschriftfarbe
.Font.ColorIndex = wksQuelle.Cells(ZeileQuelle, _
iSpalte).Offset(0, iI - 1).Font.ColorIndex
End With
Next
Else
'Aktionen wenn keine Nr. zur Informationen vorhanden
With .Range(.Cells(lngZeile, SpalteZiel), _
.Cells(lngZeile + iSpalten - 1, SpalteZiel))
'Inhalte im Bereich löschen,
.ClearContents
'Zellhintergrundfarbe auf ohne zurücksetzen
.Interior.ColorIndex = xlColorIndexNone
'Schriftfarbe in Zelle auf automatisch zurücksetzen
.Font.ColorIndex = xlAutomatic
End With
End If
End With
Set wksQuelle = Nothing
Set wksZiel = Nothing
Set Zelle = Nothing
End Sub

per Doppelklick Daten in separate Tabelle

Forumthread: per Doppelklick Daten in separate Tabelle

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

per Doppelklick Daten in separate Tabelle

Forumthread: per Doppelklick Daten in separate Tabelle

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread