Zellen mit Eintrag Storno markieren und ...

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Peter,
hier ein Vorschlag mit VBA. Der Code läuft bei jeder Änderung im Bereich B3:B6000 des entsprechenden Tabellenblattes. Der Bereich kann leicht angepasst werden, indem der Variablen "Bereich" im Code ein anderer Bereich zugewiesen wird.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Dim Ziel As Range
Dim ZInhalte()
Dim ze As Long
On Error GoTo Fehler
Set Bereich = Range("B3:B6000")
If Not Intersect(Target, Bereich) Is Nothing Then
   Application.EnableEvents = False
   ZInhalte = Bereich
   For ze = 1 To Bereich.Rows.Count
      If InStr(1, LCase(ZInhalte(ze, 1)), "storno") _
         + InStr(1, LCase(ZInhalte(ze, 1)), "strono") > 0 Then
         If Ziel Is Nothing Then
            Set Ziel = Range("B" & ze + Bereich.Row - 1)
         Else
            Set Ziel = Union(Ziel, Range("B" & ze + Bereich.Row - 1))
         End If
      End If
   Next 'ze
End If
Ziel.Interior.ColorIndex = 5
MsgBox "Insgesamt sind " & Ziel.Cells.Count & _
   " Zellen mit ""Storno"" oder ""Strono"" vorhanden " & _
   "(Groß/Kleinschreibung egal)."
Fehler:
Application.EnableEvents = True
Set Bereich = Nothing
Set Ziel = Nothing
End Sub
Gruß Ingolf

Hallo Peter,
ich hab das Makro entsprechend erweitert. Musst du halt wieder umsetzen.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Dim Ziel As Range
Dim Rest As Range
Dim ZInhalte()
Dim ze As Long
On Error GoTo Fehler
Set Bereich = Range("B3:B6000")
If Not Intersect(Target, Bereich) Is Nothing Then
   Application.EnableEvents = False
   ZInhalte = Bereich
   For ze = 1 To Bereich.Rows.Count
      If InStr(1, LCase(ZInhalte(ze, 1)), "storno") _
         + InStr(1, LCase(ZInhalte(ze, 1)), "strono") > 0 Then
         If Ziel Is Nothing Then
            Set Ziel = Range("B" & ze + Bereich.Row - 1)
         Else
            Set Ziel = Union(Ziel, Range("B" & ze + Bereich.Row - 1))
         End If
      Else
         If Rest Is Nothing Then
            Set Rest = Range("B" & ze + Bereich.Row - 1)
         Else
            Set Rest = Union(Rest, Range("B" & ze + Bereich.Row - 1))
         End If
      End If
   Next 'ze
End If
If Not Ziel Is Nothing Then
   Ziel.Interior.ColorIndex = 5
   Rest.Interior.ColorIndex = -4142
End If
MsgBox "Insgesamt sind " & Ziel.Cells.Count & _
   " Zellen mit ""Storno"" oder ""Strono"" vorhanden " & _
   "(Groß/Kleinschreibung egal)."
Fehler:
Application.EnableEvents = True
Set Bereich = Nothing
Set Ziel = Nothing
End Sub

Gruß Ingolf

Beliebteste Forumthreads (12 Monate)

Zellen mit Eintrag Storno markieren und ...

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

82 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zellen mit Eintrag Storno markieren und ...

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

82 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread