4
VBA Zellen dublizieren plus Wenn Dann Funktion
Hi Leute,
ich möchte 2 Zellen unter bestimmten Bedingungen duplizieren. Vereinfachtes Beispiel:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F4")) Is Nothing Then
On Error GoTo Errorhandler
Application.EnableEvents = False
Range("G4").Value = Target.Value
End If
Errorhandler:
Application.EnableEvents = True
End Sub
Jetzt soll nur dupliziert werden, wenn A1 = 1
Wenn A1 = 2 soll F4 mit H4 dupliziert werden.
Ich brauche ca. 20 Bedingungen
Ist das realisierbar?
Danke Euch
ich möchte 2 Zellen unter bestimmten Bedingungen duplizieren. Vereinfachtes Beispiel:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F4")) Is Nothing Then
On Error GoTo Errorhandler
Application.EnableEvents = False
Range("G4").Value = Target.Value
End If
Errorhandler:
Application.EnableEvents = True
End Sub
Jetzt soll nur dupliziert werden, wenn A1 = 1
Wenn A1 = 2 soll F4 mit H4 dupliziert werden.
Ich brauche ca. 20 Bedingungen
Ist das realisierbar?
Danke Euch
Share on Facebook
Share on Twitter
Share on Reddit
Share on LinkedinPlease also mark the comments that contributed to the solution of the article
Content-Key: 315003
Url: https://administrator.de/contentid/315003
Printed on: April 19, 2024 at 13:04 o'clock
4 Comments
Latest comment
Ich brauche ca. 20 Bedingungen
https://msdn.microsoft.com/de-de/library/cy37t14y.aspxSelect Case Range("A1").Value
Case 1
'do something
Case 2
'do another
Case 3
'again another
'...
Case Else
'do something if nothing matches above
End Select
Ich bekomme das nicht hin. Kannst Du mir den kompletten Code schicken?
Danke Dir
Danke Dir
What?? You're not able to place the above code in the event instead of the current action ?? I don't know your 20 conditions sorry.
You should learn a bit more VBA instead of copy n pasting everything.
You should learn a bit more VBA instead of copy n pasting everything.
Im Moment funktioniert immer nur das neu hinzugefügte Case, in dem Fall Case 3. Wenn ich Case 4 hinzufüge funktioniert auch wieder nur Case 4. Es kommt keine Fehlermeldung
[Edit Biber]Codetags. [/Edit]
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Range("AZ232").Value
Case 1
If Not Intersect(Target, Range("BC222")) Is Nothing Then
On Error GoTo Errorhandler
Application.EnableEvents = False
Range("BG208").Value = Target.Value
ElseIf Not Intersect(Target, Range("BC223")) Is Nothing Then
On Error GoTo Errorhandler
Application.EnableEvents = False
Range("BH209").Value = Target.Value
End If
Case 2
If Not Intersect(Target, Range("BC221")) Is Nothing Then
On Error GoTo Errorhandler
Application.EnableEvents = False
Range("BG204").Value = Target.Value
ElseIf Not Intersect(Target, Range("BC222")) Is Nothing Then
On Error GoTo Errorhandler
Application.EnableEvents = False
Range("BH207").Value = Target.Value
End If
Case 3
If Not Intersect(Target, Range("BC221")) Is Nothing Then
On Error GoTo Errorhandler
Application.EnableEvents = False
Range("BG204").Value = Target.Value
ElseIf Not Intersect(Target, Range("BC222")) Is Nothing Then
On Error GoTo Errorhandler
Application.EnableEvents = False
Range("BH205").Value = Target.Value
End If
Errorhandler:
Application.EnableEvents = True
End Select
End Sub[Edit Biber]Codetags. [/Edit]
