Automatische Ausgabe von Werten

Hallo zusammen!

Erstmal vorweg frohes neues Jahr allen!

Da ich nirgends passende Lösungen zu meinem Problem gefunden habe, habe ich mir hier neu angemeldet und bitte euch um Hilfe.
Mein Problem ist Folgendes:

Ich habe in der Spalte A verschiedene dreistellige Ziffernkombinationen (Als Beispiel: A5=100, A6=102, A7=100, A8=109, A9=107, A10=100, A11=102, usw...)
In der Spalte J habe ich dann eine Dropdownauswahlfeld mit den Auswahlmöglichkeiten "Ja" und "Nein", wobei auch die Möglichkeit gegeben ist nichts auszuwählen.

Jetzt konkret zu meiner Frage: Wenn ich in J5 "Ja" auswähle, möchte ich, dass in allen anderen Feldern von J, wo in der gleichen Zeile bei A steht, auch "Ja" ausgewählt wird automatisch. Also wenn ich bei J5 "Ja" auswähle, sollte als Beispiel bei J7 und J10 auch automatisch "Ja" ausgewählt werden.

Das gleiche soll aber nicht nur für 100 sondern für jede beliebige dreistellige Ziffernkombination gelten. Also wenn ich bei J6 "Ja" auswähle, sollte auch bei J11 "Ja" ausgewählt werden automatisch.

Ich hoffe ihr versteht was ich meine, und wenn dennoch noch Fragen sind könnt ihr euch gerne melden.

Lg Christian

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Fehler Const APPNAME = "Worksheet_Change" Dim SP As Integer, Z As Variant SP = 1 'Spalte A If Not Intersect(Target, Columns("J")) Is Nothing Then ' Läuft nur ab, bei Änderungen in Spalte J For Each Z In Intersect(UsedRange, Columns(SP)) If Z = Cells(Target.Row, SP) Then 'prüft auf gleichen Wert in Spalte A Application.EnableEvents = False Cells(Z.Row, "J") = Target.Value End If Next End If '*** Fehlerbehandlung Err.Clear Fehler: Application.EnableEvents = True If Err.Number > 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _ & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear End Sub

Ich habe jetzt versucht, die Datei zu erweitern und den gleichen Prozess auf andere Spalten auszubreiten.
Leider funktioniert dies nicht und ich weiß nicht genau wo mein Fehler liegt, ich habe eine neue Variable angelegt und den gleichen Prozess habe ich nochmals gemacht.

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo Fehler

    Const APPNAME = "Worksheet_Change"

    

    Dim SP As Integer, Z As Variant

    Dim SP2 As Integer, Z1 As Variant

    SP = 5 'Spalte E

    SP2 = 15 'Spalte O

    If Not Intersect(Target, Columns("L")) Is Nothing Then ' Läuft nur ab, bei Änderungen in Spalte L

        For Each Z In Intersect(UsedRange, Columns(SP))

            If Z = Cells(Target.Row, SP) Then 'prüft auf gleichen Wert in Spalte B

                Application.EnableEvents = False

                Cells(Z.Row, "L") = Target.Value

            End If

        Next

    If Not Intersect(Target, Columns("V")) Is Nothing Then ' Läuft nur ab, bei Änderungen in Spalte V

        For Each Z1 In Intersect(UsedRange, Columns(SP2))

            If Z1 = Cells(Target.Row, SP2) Then 'prüft auf gleichen Wert in Spalte B

                Application.EnableEvents = False

                Cells(Z2.Row, "V") = Target.Value

            End If

        Next

    End If

    '*** Fehlerbehandlung

    Err.Clear

Fehler:

    Application.EnableEvents = True

    If Err.Number > 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _

        & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear

    End If

End Sub

Wieso funktioniert meine Erweiterung nicht?

Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Fehler Const APPNAME = "Worksheet_Change" Dim SP As Integer, Z As Variant Dim SP2 As Integer, Z1 As Variant SP = 5 'Spalte E SP2 = 15 'Spalte O If Not Intersect(Target, Columns("L")) Is Nothing Then ' Läuft nur ab, bei Änderungen in Spalte L For Each Z In Intersect(UsedRange, Columns(SP)) If Z = Cells(Target.Row, SP) Then 'prüft auf gleichen Wert in Spalte B Application.EnableEvents = False Cells(Z.Row, "L") = Target.Value End If Next End If '***** If Not Intersect(Target, Columns("V")) Is Nothing Then ' Läuft nur ab, bei Änderungen in Spalte V For Each Z1 In Intersect(UsedRange, Columns(SP2)) If Z1 = Cells(Target.Row, SP2) Then 'prüft auf gleichen Wert in Spalte B Application.EnableEvents = False Cells(Z2.Row, "V") = Target.Value End If Next End If '*** Fehlerbehandlung Err.Clear Fehler: Application.EnableEvents = True If Err.Number > 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _ & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear End If End Sub

Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Fehler Const APPNAME = "Worksheet_Change" Dim SP As Integer, Z As Variant Dim SP2 As Integer, Z1 As Variant SP = 5 'Spalte E SP2 = 15 'Spalte O If Not Intersect(Target, Columns("L")) Is Nothing Then ' Läuft nur ab, bei Änderungen in Spalte L For Each Z In Intersect(UsedRange, Columns(SP)) If Z = Cells(Target.Row, SP) Then 'prüft auf gleichen Wert in Spalte B Application.EnableEvents = False Cells(Z.Row, "L") = Target.Value End If Next End If '***** If Not Intersect(Target, Columns("V")) Is Nothing Then ' Läuft nur ab, bei Änderungen in Spalte V For Each Z1 In Intersect(UsedRange, Columns(SP2)) If Z1 = Cells(Target.Row, SP2) Then 'prüft auf gleichen Wert in Spalte B Application.EnableEvents = False Cells(Z1.Row, "V") = Target.Value End If Next End If '*** Fehlerbehandlung Err.Clear Fehler: Application.EnableEvents = True If Err.Number > 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _ & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear End If End Sub

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Automatische Ausgabe von Werten

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread