Re: Makro verfeinern
01.04.2003 21:43:18
Rolf St
Hallo Rainer!
Vielen Dank für deine Hilfe!folgendes Makro läuft in Tabellenblatt Stammdaten
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngZeile As Long
Dim intCounter As Integer
Dim varSuche As Variant, varErgebnis1 As Variant
Dim varErgebnis2 As Variant, varErgebnis3 As Variant
'Makro wird nur bei Eingaben in Spalten D, E und I ausgeführt.
If Target.Column < 4 Then Exit Sub
If Target.Column >= 6 And Target.Column <= 8 Then Exit Sub
If Target.Column > 9 Then Exit Sub
If Target.Column < 9 Then
'Wenn D oder E leer ist, wird der Bereich F:H gelöscht
'und das Makro nicht weiter ausgeführt.
If IsEmpty(Range("D" & Target.Row)) Or _
IsEmpty(Range("E" & Target.Row)) Then
Application.EnableEvents = False
If Selection.Count = 1 Then
'Wurde nur 1 Zelle gelöscht, wird der Bereich F:H in
'der betreffenden Zeile gelöscht.
Range("F" & Target.Row & ":F" & Target.Row).ClearContents
Else 'Wurde ein Zellbereich gelöscht, wird auch der gesamte
'Bereich in F:H gelöscht
Range("F" & ActiveCell.Row & ":F" & ActiveCell.Row + _
Selection.Rows.Count - 1).ClearContents
End If
Application.EnableEvents = True
Exit Sub
'Wenn beide Werte in D und E numerisch sind, wird die Kombination
'der beiden Werte auch als Zahl behandelt.
ElseIf IsNumeric(Range("D" & Target.Row)) And _
IsNumeric(Range("E" & Target.Row)) Then
varSuche = (Range("D" & Target.Row) & Range("E" & Target.Row)) * 1
'Wenn einer der beiden Werte Text ist, wird auch die Kombination
'der beiden Werte als Text behandelt.
Else: varSuche = Range("D" & Target.Row) & Range("E" & Target.Row)
End If
With Worksheets("Klasseneinteilung").Range("A:A")
'Ist der Suchbegriff nicht vorhanden, wird zum ErrorHandler
'verzweigt und eine Fehlermeldung angezeigt.
On Error GoTo ErrorHandler
'Gibt es den Suchbegriff in Tabelle2, Spalte A wird
'die Zeilennummer ermittelt,
lngZeile = WorksheetFunction.Match(varSuche, .Range("A:A"), 0)
'der dazugehörige Wert aus Spalte B ausgelesen,
varErgebnis1 = .Range("B" & lngZeile).Value
'der dazugehörige Wert aus Spalte C ausgelesen,
' varErgebnis2 = .Range("C" & lngZeile).Value
'der dazugehörige Wert aus Spalte C ausgelesen.
' varErgebnis3 = .Range("D" & lngZeile).Value
If Selection.Count = 1 Then
'In Tabelle1, Spalten F, G und H (gleiche Zeile) eintragen.
Range("F" & Target.Row).Value = varErgebnis1
' Range("G" & Target.Row).Value = varErgebnis2
' Range("H" & Target.Row).Value = varErgebnis3
Else 'Wird mit Strg+Enter in einen Bereich eingegeben, werden
'die Ergebnisse aus Tabelle2 in jeder Zeile eingetragen.
For intCounter = 1 To Selection.Rows.Count
Range("F" & ActiveCell.Row - 1 + intCounter).Value _
= varErgebnis1
' Range("G" & ActiveCell.Row - 1 + intCounter).Value _
' = varErgebnis2
' Range("H" & ActiveCell.Row - 1 + intCounter).Value _
' = varErgebnis3
Next intCounter
End If
Exit Sub
End With
Else 'Bei Eingabe in Spalte I
'Ist der Suchbegriff nicht vorhanden, wird zum ErrorHandler_I
'verzweigt, eine Fehlermeldung angezeigt, die Eingabezelle
'ausgewählt und die Prozedur verlassen.
On Error GoTo ErrorHandler_I
'Bei einzelner Zelle wird die Prozedur abgebrochen, wenn diese
'Zelle leer ist, sonst wird die Eingabe als Suchbegriff fest-
'gelegt. Bei Mehrfachauswahl wird die Prozedur abgebrochen,
'wenn die aktive Zelle leer ist, sonst wird der Inhalt der
'aktiven Zelle als Suchbegriff festgelegt.
If Selection.Count = 1 Then
If IsEmpty(Target) Then Exit Sub
varSuche = Target.Value
Else: If IsEmpty(ActiveCell) Then Exit Sub
varSuche = ActiveCell.Value
End If
'Wird der Suchbegriff "varSuche" in Spalte E gefunden, passiert
'nichts weiter. Gibt es ihn nicht, wird durch die "On Error"-
'Anweisung eine Fehlermeldung angezeigt.
lngZeile = WorksheetFunction.Match(varSuche, Worksheets("Klasseneinteilung") _
.Range("E:E"), 0)
Exit Sub
End If
ErrorHandler:
MsgBox "Der Suchbegriff " & varSuche & " ist in " & _
"dem Tabellenblatt Klasseneinteilung nicht vorhanden!", vbCritical
Target.Select
Exit Sub
ErrorHandler_I:
MsgBox "Der Suchbegriff " & varSuche & " ist in " & _
"dem Tabellenblatt Klasseneinteilung nicht vorhanden!", vbCritical
Target.Select
End Sub
Ich möchte das eine Teil des Makros ausgeführt wird, wenn
ich mehrere Inhalte in Spalte D und E einfüge soll Spalte F aktualisiert werden.
Tschüß
Rolf