AW: @Franz,....
23.07.2012 15:20:20
fcs
Hallo Dominic,
ich hatte ja schon befürchtet, dass das jetzt auch noch kommt. Hättest du dir aber auch vorher überlegen können.
Du legst für Datensatz-Ändern und Datensatz-Neu besser jeweils eigene Schaltflächen im Eingabeblatt an.
Die Tabellen-Zeilennummer des per Suchen/Doppelklick in Liste gewählten Datensatzes wird dazu in eine Zelle im Eingabeblatt zwischen gespeichert. Auch die Zeile eines neuen Datensatzes wird dort eingetragen. Die Zelladresse für den Wert kannst du im Code anpassen z.Zt ist es F2.
Da viele Zeilen Betroffen/neu sind hab ich diese im Code gekennzeichnet.
Gruß
Franz
'Code in einem allgemeinen Modul der Datei.
Option Explicit
'Zelle mit der ZeilenNummer des zu ändernden Datensates
Private Const strZelleZeilenNr As String = "F2" 'NEU
Sub DatenSatz_Neu() 'NEUE PROZEDUR
Dim rngZelle As Range, lngZeileNeu As Long
With Worksheets("Liste")
'nächste freie Zeile in Liste
Set rngZelle = .Cells.Find(What:="*", after:=.Range("A1"), LookIn:=xlFormulas, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
If rngZelle Is Nothing Then
lngZeileNeu = 1
Else
lngZeileNeu = rngZelle.Row + 1
End If
Worksheets("Eingabe").Range(strZelleZeilenNr) = lngZeileNeu
Call Eingabe_in_Liste_eintragen(lngZeile:=lngZeileNeu, bolNeu:=True)
End With
End Sub
Sub DatenSatz_Aendern() 'NEUE PROZEDUR
With Worksheets("Eingabe").Range(strZelleZeilenNr)
If .Value > 0 Then
Call Eingabe_in_Liste_eintragen(lngZeile:=.Value, bolNeu:=False)
Else
MsgBox "Bitte erst einen Datensatz suchen/Neu anlegen"
End If
End With
End Sub
Sub Eingabe_in_Liste_eintragen(lngZeile As Long, bolNeu As Boolean) 'GEÄNDERT
Dim wksEingabe As Worksheet
Dim wksListe As Worksheet
'ZEILEN GELÖSCHT
Set wksEingabe = Worksheets("Eingabe") 'Eingabetabellenblatt
'Tabellenblatt in das die Daten geschrieben werden sollen
Set wksListe = Worksheets("Liste")
'ZEILEN GELÖSCHT
With wksListe
If bolNeu = True Then 'NEU
'Spalte A - automatisch Nummerieren
.Cells(lngZeile, 1).Value = Application.WorksheetFunction.Max(.Columns(1)) + 1
End If 'NEU
.Cells(lngZeile, 2).Value = wksEingabe.Range("B3")
.Cells(lngZeile, 3).Value = wksEingabe.Range("B5")
.Cells(lngZeile, 4).Value = wksEingabe.Range("E6")
.Cells(lngZeile, 5).Value = wksEingabe.Range("B10")
.Cells(lngZeile, 6).Value = wksEingabe.Range("E10")
'usw.
'oder Zellewert und Hyperlink-Infos auslesen/eintragen
.Cells(lngZeile, 7).Value = wksEingabe.Range("C12").Value
With wksEingabe.Range("C12")
If .Hyperlinks.Count > 0 Then
With .Hyperlinks(1)
wksListe.Hyperlinks.Add Anchor:=wksListe.Cells(lngZeile, 7), _
Address:=.Address
If .SubAddress "" Then _
wksListe.Cells(lngZeile, 7).Hyperlinks(1).SubAddress = .SubAddress
If .TextToDisplay "" Then _
wksListe.Cells(lngZeile, 7).Hyperlinks(1).TextToDisplay = .TextToDisplay
If .ScreenTip "" Then _
wksListe.Cells(lngZeile, 7).Hyperlinks(1).ScreenTip = .ScreenTip
End With
End If
End With
End With
End Sub
Sub SuchwertEingeben()
Dim varSuchen As Variant
Dim rngSuchen As Range
varSuchen = Application.InputBox(Prompt:="Nummer des auszulesenden Zeichensatzes", _
Title:="Datensatz einlesen", _
Type:=1)
If varSuchen False Then
Set rngSuchen = Worksheets("Liste").Columns(1).Find(What:=varSuchen, _
LookIn:=xlValues, lookat:=xlWhole)
If rngSuchen Is Nothing Then
Worksheets("Eingabe").Range(strZelleZeilenNr) = 0 'NEU
MsgBox "Datensatz-Nr. """ & varSuchen & """ nicht gefunden!", _
vbInformation + vbOKOnly, "Datensatz einlesen"
Else
Worksheets("Eingabe").Range(strZelleZeilenNr) = rngSuchen.Row 'NEU
Call Werte_aus_Liste_holen(lngZeile:=rngSuchen.Row)
End If
End If
End Sub
Public Sub Werte_aus_Liste_holen(lngZeile As Long)
Dim wksEingabe As Worksheet
Dim wksListe As Worksheet
Set wksEingabe = Worksheets("Eingabe") 'Eingabetabellenblatt
'Tabellenblatt in das die Daten geschrieben werden sollen
Set wksListe = Worksheets("Liste")
With wksListe
wksEingabe.Range("B3").Value = .Cells(lngZeile, 2).Value
wksEingabe.Range("B5").Value = .Cells(lngZeile, 3).Value
wksEingabe.Range("E6").Value = .Cells(lngZeile, 4).Value
wksEingabe.Range("B10").Value = .Cells(lngZeile, 5).Value
wksEingabe.Range("E10").Value = .Cells(lngZeile, 6).Value
'usw.
' Zellewert und Hyperlink-Infos aus Spalte 7 auslesen und in _
Eingabe-Zelle C12 einfügen
With wksEingabe.Range("C12")
If .Hyperlinks.Count > 0 Then .Hyperlinks(1).Delete
.Value = wksListe.Cells(lngZeile, 7).Value
End With
With .Cells(lngZeile, 7)
If .Hyperlinks.Count > 0 Then
With .Hyperlinks(1)
wksEingabe.Hyperlinks.Add Anchor:=wksEingabe.Range("C12"), _
Address:=.Address
If .SubAddress "" Then _
wksEingabe.Range("C12").Hyperlinks(1).SubAddress = .SubAddress
If .TextToDisplay "" Then _
wksEingabe.Range("C12").Hyperlinks(1).TextToDisplay = .TextToDisplay
If .ScreenTip "" Then _
wksEingabe.Range("C12").Hyperlinks(1).ScreenTip = .ScreenTip
End With
End If
End With
End With
End Sub
'Code im Modul von Tabellenblatt "Liste"
'Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 And IsNumeric(Target) Then
Worksheets("Eingabe").Range(strZelleZeilenNr) = Target.Row 'NEU
Call Werte_aus_Liste_holen(lngZeile:=Target.Row)
Worksheets("Eingabe").Activate
Cancel = True
End If
End Sub