Änderung in Zellbereich Adressen Zellen speichern
12.02.2018 12:11:31
Tobias.
villeicht weis einer von euch den Trick der mnir ehlt um mein Problem zu lösen.
Ich habe einen Bereich von 4 Zellen (B12:B15)in dem jede änderung zu einer Aktion führen soll.
Allerdings soll diese Änderung separate für jeden Bereich neben der jerweiligen zellen erfolgen also C12:O12, C13:O13, C14:O14, C15:O15.
Wenn sich also zwei der Zellen ändern möchte ich in den nebenstehenden Bereichen eine Aktion ausführen.
Im Moment habe ich im Modul diese Variable öffentlich definiert:
----------------------------------------------------
Public ChangeAddress As Range
Folgende Funktion überwacht den Bereich:
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, Range("B12:B15")) _
Is Nothing Then
Exit Sub
Else
Set ChangeAddress = Target.Address
Call WriteComissionValues
End If
End Sub
----------------------------------------------------
Das ist die Aktion die folgen soll:
----------------------------------------------------
Sub WriteComissionValues()
Dim SearchWord As String
Dim RightCell As Range
Dim A As Integer
Application.ScreenUpdating = False
Range("A22:A194").EntireRow.Hidden = False
If Cells(ChangeAddress).Value = "" Then
ActiveSheet.Range(ChangeAddress).Value = ""
Else
SearchWord = Cells(ChangeAddress) 'Set the "SearchWord" to the same text/value as it is written in the cell of the B
Set RightCell = ActiveSheet.Range("B24:B193").Find(What:=SearchWord, LookAt:=xlWhole, LookIn:=xlValues, _
SearchOrder:=xlByRows) 'Write the adress of the cell what matches with the "SearchWord" in the Varible "RightCell"
If Not RightCell Is Nothing Then 'If a cell matches...
A = RightCell.Row 'Write the Row number into the Variable "A"
ActiveSheet.Range(Cells(ChangeAddress, ChangeAddress.Row + 1) & ":" & Cells(ChangeAddress, ChangeAddress.Row + 13)).Value = ""
ActiveSheet.Range(Cells(ChangeAddress, ChangeAddress.Row + 1) & ":" & Cells(ChangeAddress, ChangeAddress.Row + 13)).Value = ActiveSheet.Range("C" & A & ":N" & A).Value 'Copy the whole range from the Comissions list to the 1 line of the comission chart
Else
MsgBox "There was no matching word found!"
End If
End If
Range("A22:A194").EntireRow.Hidden = True
Application.ScreenUpdating = True
End Sub
--------------------------------------------------
Das suchen der Werte und eintragen in den Beerich funktioniert sehr gut, aber nur wenn ich den gesamten Bereich anspreche und die Aktion stur für jede zeile nacheinander ablaufen lasse (For Schleife).
Ich will aber das ich z.B. die dritte Zelle ändern kann und auch nur der Bereich neben dieser Zelle aktulaisiert wird. Der rest soll in dem fall nciht geändert werden.
Da ich schon Kopfschmerzen bekomme und alles zig mal verschlimmbessert habe bitte ich euch um ein paar zusätzliche Gehirnwindungen...
Danke :-)