Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1668to1672
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Doppelte Zelleneingabeüberwachung

Doppelte Zelleneingabeüberwachung
23.01.2019 21:12:58
Julian
Hallo zusammen,
Ich habe ein Tabellenblatt 1 bei dem bei Eingabe in Spalte A aus Tabellenblatt 2 die Werte aus den Spalten B,C und E ausgelesen und kopiert werden. Nun möchte ich, dass bei Eingabe in Spalte D die Werte aus D und E multipliziert werden.
Ich habe folgenden Code - allerdings habe ich es bisher nur hinbekommen, diesen Code zum laufen zu bringen wenn der Wert in D vor dem kopieren des Wertes in E steht.
Beispieldatei: https://www.herber.de/bbs/user/127044.xlsm
Code für Multiplikation: Range("F10").Value = Range("D10").Value * Range("E10").Value
Meine Idee war es nochmal einen Sub "Private Sub Worksheet_Change(ByVal Target As Range)" einzufügen - allerdings gibt er mir dort einen Fehler aus.
Bitte um Hilfe
Viele Grüße Julian

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Doppelte Zelleneingabeüberwachung
23.01.2019 21:43:39
onur
Deine Beispieldatei und was du schreibst sind 2 verschidene Paar Schuhe.
Blatt 2 hat keine Spalte E und wo ist die Anzahl, mit der multipliziert werden soll?
Und wo ist der Code, den du bis jetzt schon hast ?
AW: Doppelte Zelleneingabeüberwachung
23.01.2019 22:52:34
Julian
Sorry, war die falsche Datei.. hier: https://www.herber.de/bbs/user/127048.xlsm
Die Anzahl möchte ich variabel in Spalte D eintragen, nachdem ich in SPalte A etwas eingegeben habe und die Werte aus Tabelle 2 übernommen wurden.
Mein Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim loSuch As Long, varZeile As Variant
If Target.Count > 1 Then Exit Sub
'Wenn Range A9:630 ist nicht nichts, dann
If Not Intersect(Range("A9:A630"), Target) Is Nothing Then
'Bereich Tabelle 2
With Worksheets("Leistungsverzeichnis")
'Suche  nach Target in Spalte 1
varZeile = Application.Match(Target, .Columns(1), 0)
'Wenn Ergebnis Nummerisch dann
If IsNumeric(varZeile) Then
'Versatz um eine Spalte nach rechts - B
Target.Offset(, 1) = .Cells(varZeile, 2)
'Versatz um 2 Spalten nach rechts - C
Target.Offset(, 2) = .Cells(varZeile, 3)
'Versatz um 4 Spalten nach rechts - E
Target.Offset(, 4) = .Cells(varZeile, 5)
'Wenn nicht
Else
'Textfeld
MsgBox "Position nicht gefunden."
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If
End With
Exit Sub
Range("F10").Value = Range("D10").Value * Range("E10").Value
End If
End Sub

Anzeige
AW: Doppelte Zelleneingabeüberwachung
24.01.2019 07:53:10
Torsten
Hallo,
das funktioniert schon. Nur hast du ein Exit Sub zu viel zwischen deinen Zeilen. Das solltest du rausloeschen.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim loSuch As Long, varZeile As Variant
If Target.Count > 1 Then Exit Sub
'Wenn Range A9:630 ist nicht nichts, dann
If Not Intersect(Range("A9:A630"), Target) Is Nothing Then
'Bereich Tabelle 2
With Worksheets("Leistungsverzeichnis")
'Suche  nach Target in Spalte 1
varZeile = Application.Match(Target, .Columns(1), 0)
'Wenn Ergebnis Nummerisch dann
If IsNumeric(varZeile) Then
'Versatz um eine Spalte nach rechts - B
Target.Offset(, 1) = .Cells(varZeile, 2)
'Versatz um 2 Spalten nach rechts - C
Target.Offset(, 2) = .Cells(varZeile, 3)
'Versatz um 4 Spalten nach rechts - E
Target.Offset(, 4) = .Cells(varZeile, 5)
'Wenn nicht
Else
'Textfeld
MsgBox "Position nicht gefunden."
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If
End With
  Exit Sub
Range("F10").Value = Range("D10").Value * Range("E10").Value
End If
End Sub

Anzeige
AW: Doppelte Zelleneingabeüberwachung
24.01.2019 08:17:37
Torsten
Oh ok. Habe gerade gesehen, dass ja dein Code fuer die Berechnung nur fuer die erste Zeile funktioniert.
Das sollte man natuerlich noch anpassen, damit das auch fuer jede Zeile funktioniert.
Hier der gesamte ueberarbeitete Code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim loSuch As Long, varZeile As Variant
If Target.Count > 1 Then Exit Sub
'Wenn Range A9:630 ist nicht nichts, dann
If Not Intersect(Range("A9:A630"), Target) Is Nothing Then
'Bereich Tabelle 2
With Worksheets("Leistungsverzeichnis")
'Suche  nach Target in Spalte 1
varZeile = Application.Match(Target, .Columns(1), 0)
'Wenn Ergebnis Nummerisch dann
If IsNumeric(varZeile) Then
'Versatz um eine Spalte nach rechts - B
Target.Offset(, 1) = .Cells(varZeile, 2)
'Versatz um 2 Spalten nach rechts - C
Target.Offset(, 2) = .Cells(varZeile, 3)
'Versatz um 4 Spalten nach rechts - E
Target.Offset(, 4) = .Cells(varZeile, 5)
'Wenn nicht
Else
'Textfeld
MsgBox "Position nicht gefunden."
Application.EnableEvents = False
Target.ClearContents
Target.Activate  'zurueck zur Positionseingabe
Application.EnableEvents = True
End If
End With
End If
'Wenn Spalte D ausgewaehlt, dann Berechnung
If Target.Column = 4 Then
Target.Offset(, 2) = Target.Value * Target.Offset(, 1).Value
End If
End Sub

Anzeige
AW: Doppelte Zelleneingabeüberwachung
24.01.2019 09:44:42
Julian
Dankeschön! Funktioniert perfekt :)
Gerne...
24.01.2019 10:52:54
Torsten
... und danke fuer die Rueckmeldung

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige