MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 09.11.2018, 10:44   #1
CStein
Neuer Benutzer
Neuer Benutzer
Standard Excel 2013 - mehrere VBA-Zeitstempel auf mehreren Sheets

Moin.

Meine Ausgangslage: Ich möchte mittels VBA je 2 verschiedene Zeitstempel auf 2 verschiedenen Sheets erzeugen (Stempel in jeweils gleicher Zeile wie der auslösende Eintrag).

* In Sheet "Tabelle 1" soll
* bei einem Eintrag in Spalte A ein Stempel in Spalte B erzeugt werden (also 1 Zelle weiter rechts) und
* bei einem Eintrag in Spalte D ein Stempel in Spalte F erzeugt werden (also 2 Zellen weiter rechts).
* In Sheet "Tabelle 2" soll
* bei einem Eintrag in Spalte AA ein Stempel in Spalte AH erzeugt werden (also 7 Zellen weiter rechts) und
* bei einem Eintrag in Spalte AD ein Stempel in Spalte AL erzeugt werden (also 8 Zellen weiter rechts).
Hierbei dürfen sich die Anweisungen nur auf die jeweilige Tabelle beziehen; d.h. bei einem Eintrag in Spalte A im Sheet "Tabelle 2" darf kein Zeitstempel erzeugt werden.

Mittels

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim RaBereich As Range
' abbrechen, wenn erste Zeile oder mehr als eine Zelle aktiv
If Target.Row < 1 Or Target.Count > 1 Then Exit Sub

Set RaBereich = Range("A1:A50")
Application.EnableEvents = False

If Not Intersect(Target, RaBereich) Is Nothing Then
Target.Offset(0, 1) = Format(Now, "dd.mm.yyyy_hh:mm:ss")
End If

Application.EnableEvents = True
Set RaBereich = Nothing

Set RaBereich = Range("d1:d50")
Application.EnableEvents = False

If Not Intersect(Target, RaBereich) Is Nothing Then
Target.Offset(0, 2) = Format(Now, "dd.mm.yyyy_hh:mm:ss")
End If

Application.EnableEvents = True
Set RaBereich = Nothing

End Sub


klappt das auch gut, nur wie müsste ich den Code ändern, sodaß (zusätzlich und nur dort) für Sheet "Tabelle 2" bei Einträgen in den Spalten AA bzw. AD jeweils Zeitstempel in den Spalten AH bzw. AL erzeugt werden (s.o.) ? Wahrscheinlich ist es für euch VBA-Profis ein Klacks, nur für mich leider nicht.

Besten Dank für eure Hilfe.
CStein ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.11.2018, 11:22   #2
Beverly
MOF Guru
MOF Guru
Standard

Hi,

der Zeitstempel in Tabelle2 soll doch nur dann erfolgen, wenn in Tabelle2 etwas eingetragen wird - oder sehe ich das falsch? Falls ich richtig liege, dann musst du den entsprechenden Code (analog zu dem in Tabelle1) ins Codemodul der Tabelle2 eintragen und den Wirkungsbereich sowie den Spaltenversatz entsprechend anpassen.


GrußformelBeverly's Excel - Inn

__________________

Bitte im Beitrag eine kurze Rückmeldung auch in dem Fall geben, wenn ein Problem gelöst wurde - dies hilft auch anderen Usern, wenn sie den betreffenden Thread lesen.
Möchtest du dich außerdem für die Hilfe bei der Lösung deines Problems bedanken? Das kannst du ganz einfach durch die Bewertung eines Beitrags (Schalter unten links).
Beverly ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.11.2018, 11:30   #3
hary
MOF Guru
MOF Guru
Standard

Moin
Code in den Code der Arbeitsmappe.
Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Select Case Sh.Name
  Case "Tabelle1"
    If Not Intersect(Target, Range("A1:A50,D1:D50")) Is Nothing Then
     Application.EnableEvents = False
     Target.Offset(, IIf(Target.Column = 1, 1, 2)) = Format(Now, "dd.mm.yyyy_hh:mm:ss")
    End If
  Case "Tabelle2"
    If Not Intersect(Target, Range("AA1:AA50,AD1:AD50")) Is Nothing Then
     Application.EnableEvents = False
     Target.Offset(, IIf(Target.Column = 27, 7, 8)) = Format(Now, "dd.mm.yyyy_hh:mm:ss")
    End If
End Select
Application.EnableEvents = True
End Sub
Oder wie Karin schrieb.
gruss hary

Geändert von hary (09.11.2018 um 11:58 Uhr). Grund: Im Code Range eingebessert
hary ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.11.2018, 11:41   #4
aloys78
MOF Meister
MOF Meister
Standard

Hallo,

folgenden Code unter DieseArbeitsmappe speichern:

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim RaBereich As Range

    If Target.CountLarge > 1 Then Exit Sub

    Application.EnableEvents = False
    Select Case Sh.Name
        Case Is = "Tabelle1"
            With Sh
                If Not Application.Intersect(Target, .Range("A1:A50")) Is Nothing Then
                    Target.Offset(0, 1) = Format(Now, "dd.mm.yyyy_hh:mm:ss")
                End If
                If Not Application.Intersect(Target, .Range("D1:D50")) Is Nothing Then
                    Target.Offset(0, 2) = Format(Now, "dd.mm.yyyy_hh:mm:ss")
                End If
            End With
        
        Case Is = "Tabelle2"
            With Sh
                If Not Application.Intersect(Target, .Range("AA1:AA50")) Is Nothing Then
                    Target.Offset(0, 7) = Format(Now, "dd.mm.yyyy_hh:mm:ss")
                End If
                If Not Application.Intersect(Target, .Range("AD1:DD50")) Is Nothing Then
                    Target.Offset(0, 7) = Format(Now, "dd.mm.yyyy_hh:mm:ss")
                End If
            End With
    End Select
    Application.EnableEvents = True
End Sub
Gruß
Aloys
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.11.2018, 11:54   #5
CStein
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Besten Dank,

klappt alles
CStein ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 06:58 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.