Live-Forum - Die aktuellen Beiträge
Datum
Titel
15.04.2024 23:32:21
Darstellung im IMAGE sehr schlecht
15.04.2024 21:08:34
PDF mit Makro erstellen mehrere Sheets
15.04.2024 18:38:39
Arbeitszeiten Vorlage ergänzen
15.04.2024 17:34:30
Fehlende Zeilen automatisch nach Zeiten ergänzen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1416to1420
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1416to1420
1416to1420
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Bereich anpassen !

Bereich anpassen !
07.04.2015 09:37:57
Weingartner
Guten Morgen!
ein Forumsmitglied war so freundlich und hat mir folgendes Makro erstellt das auch sehr gut funktioniert ich bräuchte es aber so abgeändert das es nur in den Spalten
"B bis O" wirksam ist und nicht über die ganze Tabelle !
Auf alle anderen Spalten sollte es keinen Einfluss haben.
Wäre für Lösungsvorschlag dankbar !
lg.
Dim Ding As Integer 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column > 1 And Target.Column  "" Then
'prüft, ob die zugehörige Nummernzelle befüllt ist
Target.Interior.ColorIndex = xlNone 'entfärben wenn befüllt
ActiveWorkbook.Save
Else
Target.Offset(2, 0).Select
Target.Offset(2, 0).Interior.Color = RGB(153, 255, 51) 'grün wenn leer
End If
Else
End If
Ding = 0
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Ding = 1 Then
Exit Sub
End If
If Target.Column > 1 And Target.Column  "" And Target.Offset(-2, 0)  "" Then
'prüft, ob die Nummernzelle und die Datumszelle befüllt sind
Target.Interior.ColorIndex = xlNone
ActiveWorkbook.Save
Else
Target.Offset(-2, 0).Select
Target.Offset(-2, 0).Interior.Color = RGB(153, 255, 51)
End If
Else
If Target.Offset(-1, 0) = "Datum" And Target  "" And Target.Offset(2, 0)  "" Then
'prüft, ob das Datum normal reingeschrieben wurde und nicht per Doppelklick
Target.Interior.ColorIndex = xlNone
ActiveWorkbook.Save
Else
Target.Offset(2, 0).Select
Target.Offset(2, 0).Interior.Color = RGB(153, 255, 51)
End If
End If
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: Bereich anpassen !
07.04.2015 10:16:29
EtoPHG
Hallo Weingartner,
Das Makro ist mit Kommentaren versehen und prüft genau die Spalten B bis O.
Also was zum Teufel willst Du?
Gruess Hansueli

AW: Bereich anpassen !
07.04.2015 10:44:39
Weingartner
Hallo !
wenn ich in spalte A oder zb P irgendwo doppelklicks setze werden zellen auch eingefärbt das sollte nicht sein !
lg

AW: Bereich anpassen !
07.04.2015 12:45:58
EtoPHG
Hallo,
Lösche im 2ten If des Change_Events den ganzen Else-Teil.
Gruess Hansueli

AW: Bereich anpassen !
07.04.2015 12:57:27
Weingartner
Hallo !
wie müsste das dann ausschauen!
was genau gehört weg ?
wäre für Lösung dankbar!
lg

AW: Bereich anpassen !
07.04.2015 15:14:08
Nepumuk
Hallo,
so:
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
    'prüft, ob es in den Spalten zwischen B und O ist
    If Target.Column > 1 And Target.Column < 16 Then
        
        'und ob die Zelle darüber "Datum" heißt
        If Target.Offset(-1, 0).Value = "Datum" Then
            
            'trägt aktuelles Datum ein
            Application.EnableEvents = False
            Target.Value = Date
            Application.EnableEvents = True
            
            'prüft, ob die zugehörige Nummernzelle befüllt ist
            If Target.Offset(2, 0) <> "" Then
                Target.Interior.Pattern = xlPatternNone 'entfärben wenn befüllt
                ThisWorkbook.Save
            Else
                Target.Offset(2, 0).Select
                Target.Offset(2, 0).Interior.Color = RGB(153, 255, 51) 'grün wenn leer
            End If
            
            Cancel = True
            
        End If
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    
    'prüft, ob es in den Spalten zwischen B und O ist
    If Target.Column > 1 And Target.Column < 16 Then
        
        'und ob die Zelle darüber "Nummer" heißt
        If Target.Offset(-1, 0).Value = "Nummer" Then
            
            'prüft, ob die Nummernzelle und die Datumszelle befüllt sind
            If Not IsEmpty(Target.Value) And Not IsEmpty(Target.Offset(-2, 0).Value) Then
                Target.Interior.Pattern = xlPatternNone
                ThisWorkbook.Save
            Else
                Target.Offset(-2, 0).Select
                Target.Offset(-2, 0).Interior.Color = RGB(153, 255, 51) 'grün wenn leer
            End If
            
            'prüft, ob das Datum normal reingeschrieben wurde und nicht per Doppelklick
        ElseIf Target.Offset(-1, 0).Value = "Datum" Then
            
            'prüft, ob die Nummernzelle und die Datumszelle befüllt sind
            If Not IsEmpty(Target.Value) And Not IsEmpty(Target.Offset(2, 0).Value) Then
                Target.Interior.Pattern = xlPatternNone
                ThisWorkbook.Save
            Else
                Target.Offset(2, 0).Select
                Target.Offset(2, 0).Interior.Color = RGB(153, 255, 51) 'grün wenn leer
            End If
        End If
    End If
End Sub

Gruß
Nepumuk

Anzeige
Weg mit dem Crap und das hier rein!
07.04.2015 15:25:27
EtoPHG
Hallo Weingartner,
Wirf allen (Klexy)-Code in die Tonne.
Dieser Code im Tabellenblatt: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lOffset As Long
If Target.Row > 9 And _
Target.Column > 1 And Target.Column  0 And Len(.Value) > 0) Then
.Interior.ColorIndex = xlColorIndexAutomatic
Target.Interior.ColorIndex = xlColorIndexAutomatic
ThisWorkbook.Save
Else
.Interior.ColorIndex = 3
.Activate
End If
End With
End If
End If
End Sub
prüft ob eine Datum-Zelle und eine zugehörige Nummer-Zelle entweder etwas enthalten, oder leer sind. Wenn ja, wird die Mappe gesichert, wenn nein, wird jeweils die Partner-Zelle rot gefärbt und für eine Eingabe oder Löschung aktiviert.
Gruess Hansueli

Anzeige
Verbesserung zu meinem Code oben
07.04.2015 15:44:06
EtoPHG
Hallo,
Einige kleine Anpassungen:
a) Funktioniert nun auch, wenn mehrere Zellen gleichzeitig geändert werden.
b) Prüft ob Zelle über dem Targetbeschrieben ist, bzw. verhindert das Ausführen im Zellbereich unter den vorformatierten Zellebereichen.
c) setzt den Colorindex der Zellen auf den Standard zurück
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lOffset As Long
Dim rC As Range
If Target.Row > 9 And _
Target.Column > 1 And Target.Column  0 Then
With rC.Offset(lOffset)
If (Len(rC) = 0 And Len(.Value) = 0) Or _
(Len(rC) > 0 And Len(.Value) > 0) Then
.Interior.ColorIndex = xlColorIndexNone
Target.Interior.ColorIndex = xlColorIndexNone
ThisWorkbook.Save
Else
.Interior.ColorIndex = 3
.Activate
End If
End With
End If
Next rC
End If
End Sub
Gruess Hansueli

Anzeige
Sandfüllen - Arbeitsmappe
07.04.2015 16:10:27
EtoPHG
Hallo Weingartner,
Du solltest vielleicht jeweils die neueste Mappe hochladen.
In der Zwischenzeit habe ich noch eine andere gefunden, die auf dem Tabellenblatt den grossen Titel "Sandfüllen" trägt. In dieser sind die Listenstrukturen an anderer Stelle, wie im ersten Beispiel. Hier müsste der Code so lauten: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lOffset As Long
Dim rC As Range
If Target.Row > 7 And _
Target.Column > 1 And Target.Column  0 Then
With rC.Offset(lOffset)
If (Len(rC) = 0 And Len(.Value) = 0) Or _
(Len(rC) > 0 And Len(.Value) > 0) Then
.Interior.ColorIndex = xlColorIndexNone
Target.Interior.ColorIndex = xlColorIndexNone
ThisWorkbook.Save
Else
.Interior.ColorIndex = 3
.Activate
End If
End With
End If
Next rC
End If
End Sub
Gruess Hansueli

Anzeige
AW: Sandfüllen - Arbeitsmappe
08.04.2015 07:36:42
Weingartner
Guten Morgen !
Recht herzlichen Dank für die Lösungsansätze.
lg

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige