ich bitte euch um eine kleine Änderung an am Ende stehendem Makro, meine VBA Kenntnisse reichen leider nicht aus.
Bislang reagiert das Makro auf eine Eingabe in Spalte B und macht dann das was es halt macht und auch tun soll.
Bei der Eingabe von mehr als 132 Zeilen fügt es noch eine Leerzeile ein.
Alles schön und gut.
Ist es möglich, dass das Makro nur dann startet, wenn ich mindestens 2 Zeilen einfüge?
Mir geht es speziell darum, dass ich einzelne Zellen in Spalte B überschreiben kann, ohne dass das Makro ausgeführt wird.
Hat da jemand eine Lösung für mich? Das was das Makro bislang macht, soll auch weiterhin gemacht werden, nur halt nicht mehr wenn ich eine einzelne Zelle in Spalte B überschreibe.
Gruß
Christian
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
Const APPNAME = "Worksheet_Change"
Dim RNG As Range, TMP As String, MMAx As Integer
Dim Z0 As Integer, Z1 As Integer, Sp As Integer, i As Long
'Nur Spalte B berücksichtigen
Set RNG = Intersect(Columns(2), Target)
Z0 = 2 'Erster Durchlauf aus 2. Wert
Z1 = 3 'StartZeile im Bereich
MMAx = 132
If Target.Column = 2 And Target.Columns.Count = 1 Then
If WorksheetFunction.CountBlank(RNG) = RNG.Count Then Exit Sub ' falls nur Leerzellen
Application.ScreenUpdating = False
Application.EnableEvents = False
For i = Z0 To RNG.Count Step 4
TMP = Target.Cells(i) 'der aktuelle Text
If i = Z0 Then i = Z0 - 3 ' von 2 auf 3 ändern
'Zählen, ob Text schon im Zielbereich vorhanden idt
If WorksheetFunction.CountIf(Target.Cells(1).Resize(1, Sp + 1), TMP) = 0 Then
'wenn neu, dann anfügen
Target.Cells(1).Offset(0, Sp) = TMP
Sp = Sp + 1
End If
Next
'Einfügebereich löschen, außer erste Zelle
RNG.Offset(1, 0).Resize(RNG.Count - 1).ClearContents
'Leerzeile
If RNG.Count > MMAx Then
Rows(Target.Row + 1).Insert
End If
Application.EnableEvents = True
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