Zum Testen
11.10.2017 16:29:44
Michael
Hallo Volker!
Hier Deine Bsp-Datei mit meinen Erweiterungen retour: https://www.herber.de/bbs/user/116880.xlsm
Makros finden sich im allgemeinen Modul1, sowie im Modul der Tabelle1.
Ich habe ein zweites Tabellenblatt "Tabelle2" hinzugefügt, wo Du die Parameter setzen kannst.
Funktionsweise:
- Der gesuchte Datumsbereich (Von/Bis) wird im Blatt2 eingetragen. Ich habe hier zur Eingabekontrolle auf eine Datengültigkeit gesetzt, schau auch dort nach.
- Der gewünschte Erhöhungswert wird im Blatt2 eingetragen (auch hier mit Datengültigkeit).
- Die Wert-Änderung wird im Blatt1 ausgelöst, wenn Du in der ersten Spalte der betroffenen Reihe einen Doppelklick ausführst (also in die erste Zelle der jeweiligen Zeile).
- Der Bereich, in dem Werte geändert wurden, wird ausgewählt/markiert.
Die Benennung der Tabellenblätter kannst Du ändern, musst dies dann aber auch im Code (im Modul1) entsprechend anpassen (ist kommentiert).
Hier nur der Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
If .Column = 1 And .Row > 1 And .Cells.Count = 1 Then
ZellwerteErhoehen (.Row)
Cancel = True
End If
End With
End Sub
Sub ZellwerteErhoehen(Zeile As Long)
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle1") 'anpassen
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle2") 'anpassen
Dim Von As Range, Bis As Range, Bereich As Range, Zelle As Range
Application.ScreenUpdating = False
With WsZ
Set Von = .Range(.Cells(1, 2), _
.Cells(1, .Columns.Count).End(xlToLeft)).Find(what:=WsQ.Range("A3"), _
LookIn:=xlValues, lookat:=xlWhole)
If Not Von Is Nothing Then
Set Bis = .Range(.Cells(1, 2), .Cells(1, _
.Columns.Count).End(xlToLeft)).Find(what:=WsQ.Range("A4"), _
LookIn:=xlValues, lookat:=xlWhole)
If Not Bis Is Nothing Then
Set Bereich = .Range(.Cells(Zeile, Von.Column), _
.Cells(Zeile, Bis.Column))
For Each Zelle In Bereich
Zelle.Value = Zelle.Value + WsQ.Range("A5")
Next Zelle
Bereich.Select
Else:
MsgBox "Bis-Datum wurde nicht gefunden!"
Exit Sub
End If
Else:
MsgBox "Von-Datum wurde nicht gefunden!"
Exit Sub
End If
End With
Set Wb = Nothing: Set WsZ = Nothing: Set WsQ = Nothing
Set Von = Nothing: Set Bis = Nothing: Set Bereich = Nothing
Set Zelle = Nothing
End Sub
Kommst Du damit hin?
LG
Michael