Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
24.04.2024 17:19:09
Anzeige
Archiv - Navigation
1076to1080
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

Makroproblem !

Makroproblem !
04.06.2009 08:24:32
Ernst
Hallo vba Experten !
Habe folgende Problemstellung: bei den unten angeführten Makros kommt es zu folgendem Problem wenn ich das aktuelle Datum per Doppelklick einfüge führt es im Tabellenblatt Archiv dazu das drei Zellen mit dem Aktuellem Datum gefüllt werden bei Änderung des Eintrags auf Offset(0, -0) sinds dann nur mehr zwei !bei manueller Änderung des Datums wird nur eine Zelle im Archiv gefüllt so wie ich es gerne hätte.
Meine Frage ? gibt es eine Möglichkeit das per Doppelklick zwar zwei Zellen im Archiv mit dem Datum befüllt werden anschliesend jedoch eine wieder gelöscht wird !
Wäre für Lösungen sehr dankbar.
lg.Ernst
ps.es wäre wichtig für mich beide Möglichkeiten nützen zu können.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Long
Dim zelle As Long
If Target.Row > 4 And (Target.Column = 2 Or Target.Column = 6 Or Target.Column = 10) Then
Target.Value = Format(Date, "dd.mm.yyyy")
For i = 5 To 247
zelle = Sheets("Archiv").Cells(i, Columns.Count).End(xlToLeft).Column + 1
If Sheets("Archiv").Cells(i, 1) = Cells(Target.Row, Target.Column).Offset(0, -1).Value Then
Sheets("Archiv").Cells(i, zelle) = Cells(Target.Row, Target.Column).Value
End If
Next
ElseIf Target.Column = 3 Or Target.Column = 7 Or Target.Column = 11 Then
UserForm1.Show
End If
End Sub



Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim zelle As Long
For i = 5 To 247
zelle = Sheets("Archiv").Cells(i, Columns.Count).End(xlToLeft).Column + 1
If Sheets("Archiv").Cells(i, 1) = Cells(Target.Row, Target.Column).Offset(0, -1).Value Then
Sheets("Archiv").Cells(i, zelle) = Cells(Target.Row, Target.Column).Value
End If
Next
End Sub


6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makroproblem !
04.06.2009 09:00:28
Nepumuk
Hallo Ernst,
so?
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim i As Long
    Dim zelle As Long
    If Target.Row > 4 And (Target.Column = 2 Or Target.Column = 6 Or Target.Column = 10) Then
        Application.EnableEvents = False
        With Target
            .NumberFormat = "dd.mm.yyyy"
            .Value = Date
        End With
        Application.EnableEvents = True
        For i = 5 To 247
            zelle = Sheets("Archiv").Cells(i, Columns.Count).End(xlToLeft).Column + 1
            If Sheets("Archiv").Cells(i, 1) = Cells(Target.Row, Target.Column).Offset(0, -1).Value Then
                Sheets("Archiv").Cells(i, zelle) = Cells(Target.Row, Target.Column).Value
            End If
        Next
        Cancel = True
    ElseIf Target.Column = 3 Or Target.Column = 7 Or Target.Column = 11 Then
        UserForm1.Show
        Cancel = True
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long
    Dim zelle As Long
    For i = 5 To 247
        zelle = Sheets("Archiv").Cells(i, Columns.Count).End(xlToLeft).Column + 1
        If Sheets("Archiv").Cells(i, 1) = Cells(Target.Row, Target.Column).Offset(0, -1).Value Then
            Sheets("Archiv").Cells(i, zelle) = Cells(Target.Row, Target.Column).Value
        End If
    Next
End Sub

Gruß
Nepumuk
Anzeige
AW: Perfekt
04.06.2009 09:39:15
Ernst
Hallo Nepumuk !
Perfekt genau so wie ich mir das vorgestellt habe.
Recht herzlichen Dank !
Lg.Ernst
AW: Hey Nepumuk !
04.06.2009 12:06:55
Ernst
Hallo Nepumuk !
mir ist aufgefallen wenn ich eine neue Wagennummer in Tabellenblatt 1 Spalt a eingebe kommt es zu einem Laufzeitfehler 1004.
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Long
Dim zelle As Long
If Target.Row > 4 And (Target.Column = 2 Or Target.Column = 6 Or Target.Column = 10) Then
Application.EnableEvents = False
With Target
.NumberFormat = "dd.mm.yyyy"
.Value = Date
End With
Application.EnableEvents = True
For i = 5 To 247
zelle = Sheets("Archiv").Cells(i, Columns.Count).End(xlToLeft).Column + 1
If Sheets("Archiv").Cells(i, 1) = Cells(Target.Row, Target.Column).Offset(0, -1). _
Value Then
Sheets("Archiv").Cells(i, zelle) = Cells(Target.Row, Target.Column).Value
End If
Next
Cancel = True
ElseIf Target.Column = 3 Or Target.Column = 7 Or Target.Column = 11 Then
UserForm1.Show
Cancel = True
End If
End Sub



Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim zelle As Long
For i = 5 To 247
zelle = Sheets("Archiv").Cells(i, Columns.Count).End(xlToLeft).Column + 1
If Sheets("Archiv").Cells(i, 1) = Cells(Target.Row, Target.Column).Offset(0, -1). _
Value Then
Sheets("Archiv").Cells(i, zelle) = Cells(Target.Row, Target.Column).Value
End If
Next
End Sub


Anzeige
AW: Change ereigniss
04.06.2009 18:35:53
hary
Hallo Ernst
Hab ueber den Dreifach Eintrag gegruebelt, dabei so einfach Cancel. Aber Nepumuk hat es ja geschafft ;-))
Wegen Eintrag neuer Nr., versuch mal dies:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim zelle As Long
For i = 5 To 247
If Target.Column = 2 Or Target.Column = 6 Or Target.Column = 10 Then
zelle = Sheets("Archiv").Cells(i, Columns.Count).End(xlToLeft).Column + 1
If Sheets("Archiv").Cells(i, 1) = Cells(Target.Row, Target.Column).Offset(0, -1).Value  _
Then
Sheets("Archiv").Cells(i, zelle) = Cells(Target.Row, Target.Column).Value
End If
End If
Next
End Sub


Gruss Hary

Anzeige
AW: Change ereigniss
04.06.2009 18:36:18
hary
Hallo Ernst
Hab ueber den Dreifach Eintrag gegruebelt, dabei so einfach Cancel. Aber Nepumuk hat es ja geschafft ;-))
Wegen Eintrag neuer Nr., versuch mal dies:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim zelle As Long
For i = 5 To 247
If Target.Column = 2 Or Target.Column = 6 Or Target.Column = 10 Then
zelle = Sheets("Archiv").Cells(i, Columns.Count).End(xlToLeft).Column + 1
If Sheets("Archiv").Cells(i, 1) = Cells(Target.Row, Target.Column).Offset(0, -1).Value  _
Then
Sheets("Archiv").Cells(i, zelle) = Cells(Target.Row, Target.Column).Value
End If
End If
Next
End Sub


Gruss Hary

Anzeige
AW: Funktioniert 1a.Danke
04.06.2009 22:25:33
weingartner
Hallo Hary !
Funktioniert 1a.
Thx
lg.Ernst

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige