Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 11:49:37
Array verwenden
25.04.2024 10:38:52
Bedingte Formatierung per VBA / MaxPoint
25.04.2024 10:30:04
Suche mit MINWENNS und Rückgabe mehrerer Werte
25.04.2024 09:47:49
Daten aus mehreren Dateien untereinander importieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1584to1588
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
1584to1588
1584to1588
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

eintrag rechts neben beschriebener Zelle

eintrag rechts neben beschriebener Zelle
12.10.2017 12:04:43
Lisa
Hallo zusammen.
Anbei mein Makro, mit dem ich bei einer Zelländerung der Zelle in der Spalte A (A2:A50), den User in die Spalte M der gleichen Zeile einträgt.
Meine Frage hierzu nun.
Wie müsste das Makro geändert werden, damit bei nochmaliger Änderung der User in der rechten Nachbarzelle eingetragen wird und das fortlaufend.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
If Not Intersect(Target, Range("A2:A50")) Is Nothing Then
For Each Zelle In Intersect(Target, Range("A2:A50"))
Zelle.Offset(0, 12).Value = Environ("username")
Next
End If
End Sub
Danke und liebe Grüße Lisa

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: eintrag rechts neben beschriebener Zelle
12.10.2017 12:22:43
Nepumuk
Hallo Lisa,
teste mal:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Zelle As Range, Bereich As Range
    Dim Ausgabespalte As Long
    Set Bereich = Intersect(Target, Range("A2:A50"))
    If Not Bereich Is Nothing Then
        For Each Zelle In Bereich
            Ausgabespalte = WorksheetFunction.Max(12, Cells(Zelle.Row, Columns.Count).End(xlToLeft).Column)
            Zelle.Offset(0, Ausgabespalte).Value = Environ$("USERNAME")
        Next
        Set Bereich = Nothing
    End If
End Sub

Gruß
Nepumuk
Anzeige
AW: eintrag rechts neben beschriebener Zelle
12.10.2017 13:49:52
Lisa
... Klasse.
Hallo Nepumuk, funktioniert tadellos.
Evtl. noch eine weiter Frage?
Wenn ich das Makro so ändere wie u.g., wird der Änderung einer anderen Spalt neben Leerspalten geschrieben.
Hast du hierzu evtl. auch eine Idee?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range, Bereich As Range
Dim Ausgabespalte As Long
Set Bereich = Intersect(Target, Range("A2:A50"))
If Not Bereich Is Nothing Then
For Each Zelle In Bereich
Ausgabespalte = WorksheetFunction.Max(12, Cells(Zelle.Row, Columns.Count).End( _
xlToLeft).Column)
Zelle.Offset(0, Ausgabespalte).Value = Environ$("USERNAME")
Next
Set Bereich = Nothing
End If
Set Bereich = Intersect(Target, Range("F2:F50"))
If Not Bereich Is Nothing Then
For Each Zelle In Bereich
Ausgabespalte = WorksheetFunction.Max(12, Cells(Zelle.Row, Columns.Count).End( _
xlToLeft).Column)
Zelle.Offset(0, Ausgabespalte).Value = Environ$("USERNAME")
Next
Set Bereich = Nothing
End If
End Sub
Vielen Dank und liebe Grüße
Anzeige
AW: eintrag rechts neben beschriebener Zelle
12.10.2017 14:07:30
Nepumuk
Hallo Lisa,
so ok?
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Zelle As Range, Bereich As Range
    Dim Ausgabespalte As Long
    Set Bereich = Intersect(Target, Range("A2:A50,F2:F50"))
    If Not Bereich Is Nothing Then
        Application.EnableEvents = False
        For Each Zelle In Bereich
            Ausgabespalte = WorksheetFunction.Max(13, Cells(Zelle.Row, Columns.Count).End(xlToLeft).Column + 1)
            Cells(Zelle.Row, Ausgabespalte).Value = Environ$("USERNAME")
        Next
        Set Bereich = Nothing
        Application.EnableEvents = True
    End If
End Sub

Gruß
Nepumuk
Anzeige
AW: eintrag rechts neben beschriebener Zelle
12.10.2017 14:32:41
Lisa
Hallo Nepumuk, perfekt und vielen Dank.
Liebe Grüße Lisa

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige