Abänderung VBA-Code

Private Sub Worksheet_Change(ByVal Target As Range) 'Fügt Formel zur Ermittlung des Gruppe in Spalte I:I ein, wenn in Spalte B ein neuer Name geschrieben wurde: If Target.Column = 2 Then On Error GoTo Punkt_A Application.EnableEvents = False If Target <> "" Then Target.Offset(0, 7).FormulaLocal = _ "=wenn(istzahl(E" & Target.Row & ");SVERWEIS(A" & Target.Row & ";gruppenliste;2);"""")" ' Formel: =WENN(ISTZAHL(E1);SVERWEIS(A1;gruppenliste;2);"") Else Target.Offset(0, 7).ClearContents End If End If Punkt_A: Application.EnableEvents = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Bernd,
ungetestet, und du kannst nur eine von beiden Subs haben, also andere auskommentieren/umbenenne beim Testen.
Und beachte den vierten Parameter bei Sverweis!

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range, Zelle As Range
Set Bereich = Intersect(Target, Columns(2))
If Bereich Is Nothing Then Exit Sub ' in B wurde nichts geändert
On Error GoTo Fehler
Application.EnableEvents = False
For Each Zelle In Bereich
Zelle.Offset(0, 7).ClearContents
' Formel: =WENN(ISTZAHL(E1);SVERWEIS(A1;gruppe;2);"")
If Zelle.Value <> "" Then Zelle.Offset(0, 7).FormulaLocal = _
"=wenn(istzahl(E" & Target.Row & ");SVERWEIS(A" & Target.Row & ";gruppe;2);"""")"
Next Zelle
Fehler:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range, Zelle As Range
Set Bereich = Intersect(Target, Columns(2))
If Bereich Is Nothing Then Exit Sub ' in B wurde nichts geändert
On Error GoTo Fehler
Application.EnableEvents = False
For Each Zelle In Bereich
Zelle.Offset(0, 7).ClearContents
' Formel: =WENN(ISTZAHL(E1);SVERWEIS(A1;gruppe;2);"")
If Zelle.Value <> "" Then Zelle.Offset(0, 7).Value = Application.WorksheetFunction.if(IsNumber(Range("E" & Zelle.Row)) _
, Application.WorksheetFunction.VLookup(Range("A" & Target.Row), Range(gruppe), 2, 0), "")
Next Zelle
Fehler:
Application.EnableEvents = True
End Sub

Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Columns.Count + Target.Column >= 2 Then If (Target.Column = 2 And Target.Columns.Count = 1) Or (Target.Column <= 2 And Target.Columns.Count >= 2) Then On Error GoTo Punkt_A Application.EnableEvents = False If Target <> "" Then Target.Offset(0, 7).FormulaLocal = _ "=wenn(istzahl(E" & Target.Row & ");SVERWEIS(A" & Target.Row & ";gruppe;2);"""")" ' Formel: =WENN(ISTZAHL(E1);SVERWEIS(A1;gruppe;2);"") Else Target.Offset(0, 7).ClearContents End If End If End If Punkt_A: Application.EnableEvents = True End Sub

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread