Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1176to1180
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Private Sub Worksheet_Change in Modul auslagern

Private Sub Worksheet_Change in Modul auslagern
Claudia
Hallo zusammen,
möchte folgenden Code aus

Private Sub Worksheet_Change(ByVal Target As Range) in ein Modul auslagern. Soll heissen: unabhä _
_
ngig von einer Eingabe wie dargestellt soll ein Makro hingehen und prüfen, ob aufgrund der  _
Werte im genannten I-Bereich noch Änderungen / Ergänzungen vorgenommen werden sollen.
Leider sind VBA und ich nicht kompatibel. Jedenfalls scheitere ich an einer Modifzierung.
Viele Grüße
Claudia
Dim Bereich2 As Range
Set Bereich2 = Intersect(Range("i2:i10000"), Target)
If Not Bereich2 Is Nothing Then
Application.EnableEvents = False
With Bereich2
If .Offset(0, 0).Value = "4 = keine Priorität" And .Offset(0, 5).Value = "" Or _
.Offset(0, 0).Value = "4 = keine Priorität" And .Offset(0, 5).Value = "-" Or _
.Offset(0, 0).Value = "4 = keine Priorität" And .Offset(0, 5).Value = "offen" Or _
.Offset(0, 0).Value = "4 = keine Priorität" And .Offset(0, 5).Value = "umgesetzt bzw. erledigt"  _
_
Then
.Offset(0, 5).Value = "erledigt"
.Offset(0, 8).Value = "keine Umsetzung geplant"
Else
End If
If .Offset(0, 0).Value = "noch nicht priorisiert" Then
.Offset(0, 5).Value = "offen"
.Offset(0, 8).Value = "offen"
Else
End If
End With
End If
End Sub

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Private Sub Worksheet_Change in Modul auslagern
12.09.2010 21:11:38
Gerd
Hallo Claudia!
Sub start()
Call Normale(ThisWorkbook.Sheets("Tabelle1").Range("i2:i3"))
End Sub

Sub Normale(Optional rngBereich As Range)
Dim rngPruefbereich As Range, rngCell As Range
On Error GoTo errEXIT
Application.EnableEvents = False
If rngBereich Is Nothing Then Set rngBereich = ActiveCell
Set rngPruefbereich = Intersect(rngBereich.Parent.Range("i2:i10000"), rngBereich)
If rngPruefbereich Is Nothing Then Exit Sub
For Each rngCell In rngPruefbereich
With rngCell
If .Value = "4 = keine Priorität" Then
Select Case .Offset(0, 5).Value
Case "", "-", "offen", "umgesetzt bzw. erledigt"
.Offset(0, 5).Value = "erledigt"
.Offset(0, 8).Value = "keine Umsetzung geplant"
End Select
End If
If .Value = "noch nicht priorisiert" Then
.Offset(0, 5).Value = "offen"
.Offset(0, 8).Value = "offen"
End If
End With
Next rngCell
errEXIT:
Application.EnableEvents = True
End Sub
Gruß Gerd
Anzeige
Vielen Dank, klappt prima!
13.09.2010 07:04:40
Claudia

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige