AW: Eingabeüberwachung -Werte übernehmen mit Makro
01.05.2010 10:21:00
fcs
Hallo Andreas,
für einen VBA-Anfänger sind Modifikationen an einer Prozedur manchmal nicht ganz einfach.
Das ist natürlich um so schwieriger, wenn nicht optimal in ihrer Struktur ist.
5 allgemeine Hinweise (auch wenn du die Prozedur geschenkt bekommen hast)
1. verwende aussagekräftige Variablennamen (y, r, s, t, l, m etc. ist da nicht so doll)
2. verwende "Select Case" statt If mit vielen Or-Bedingungen, liest sich wesentlich leichter.
3. Füge ausreichend Kommentare ein, damit du -und speziell andere Anwender- wissen was die Prozedur und Anweisungen machen sollen.
4. Achte beim Verschachteln von If-Bedingungen darauf, dass die allgemeinen Bedingungen (in deinem Fall die Zeilen, in die Eingaben geprüft werden sollen) außen (zuerst) und die speziellen (hier die Spalten) innen (danach)stehen. Dann ersparst du dir die Wiederholung von Prozedurabschnitten.
5. Deaktiviere die Ereignismakros, wenn von dem gestarteten Makro Zellwerte in der Tabelle geädert werden. Es kommt sonst zu unerwünschten/unötigen wiederholten AUfrufen des Change-Ereignismakros.
Nachfolgende das Makro für die gewünschte Darstellung.
Gruß
Franz
Private Sub Worksheet_Change(ByVal Target As Range)
Dim bPosNrVorhanden As Boolean, bLastNrVorhanden As Boolean
Dim sEingabe As String, sPosNr As String, sLastNr As String
Dim lZeile As Long, lZeileLetzte As Long, lSpalte As Long
On Error GoTo fehler
Application.EnableEvents = False
Select Case Target.Row
Case 6 To 49, 55 To 98 'Eingabe Zeilen
Select Case Target.Column
Case 10, 13, 16, 19 'Eingabespalten "da pos."
sEingabe = Target.Value
'Positionsnummer aus Eingabe ermitteln
sPosNr = Left(sEingabe, 4)
If Right(sPosNr, 1) = "/" Then
sPosNr = Left(sEingabe, 3)
Else
Select Case Right(sPosNr, 2)
Case "/1", "/2", "/3", "/4", "/5", "/6"
sPosNr = Left(sEingabe, 2)
Case Else
'do nothing
End Select
End If
'Zählnummer der Last
sLastNr = Right(sEingabe, 1)
'Werte zur Positions-Nummer aus Blatt "0" holen
With Sheets("0")
'Letzte Zeile Spalte A
lZeileLetzte = .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 0).Row
'Positions-Nummer in Spalte A ab Zeile 7 suchen
bPosNrVorhanden = False
For lZeile = 7 To lZeileLetzte Step 2
If .Cells(lZeile, 1).Value = sPosNr Then
bPosNrVorhanden = True
bLastNrVorhanden = False
'Last-Nr. mit Eintrag in Spalten 9 bis 14 (ständige Last) _
der Zeile 6 vergleichen
For lSpalte = 9 To 14 Step 1
If .Cells(6, lSpalte).Value = sLastNr Then
'2 Spalten links von Eingabezelle die ständige Last zu Position _
eintragen
Target.Offset(0, -2).Value = .Cells(lZeile, lSpalte).Value
'1 Spalte links von Eingabezelle die veränderlichen Lasten _
zu Position eintragen (Wert 6 Spalten rechts von ständige Last)
Target.Offset(0, -1).Value = .Cells(lZeile, lSpalte + 6).Value
Cells(Target.Row + 1, Target.Column - 1) = _
.Cells(lZeile + 1, lSpalte + 6).Value
bLastNrVorhanden = True
Exit For
End If
Next lSpalte
If bLastNrVorhanden = False Then
MsgBox "Eintrag zu Lastnummer nicht vorhanden"
End If
Exit For
End If
Next lZeile
If bPosNrVorhanden = False Then
MsgBox "Eintrag zu Positions-Nummer nicht vorhanden"
End If
End With
Case Else ' - Spalten
'do nothing
End Select
Case Else ' - Zeilen
'do nothing
End Select
fehler:
Application.EnableEvents = True
End Sub