Formeln und Makros

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row >= 6 And Target.Row = 8 And Target.Column "" Then 'prüfen ob eintrag angehangen wird vareintrag = vareintrag & ", " & Left(var_datum, 6) 'eintrag vornehmen, _ begrenzung auf 6 stellen Else vareintrag = Left(var_datum, 6) 'eintrag auf 6 stellen begrenzt End If End If Next x 'zelle in nächster spalte prüfen If var_datum "" Then Cells(icounter, 254).Value = vareintrag 'eintrag suchergebnis vareintrag = "" 'löschen der variable für nächste suche Next icounter 'nächste zeile ansteuern wenn matrix abgesucht wird Cells(y, Z).Select 'cursor auf gewünschten punkt setzen End If Application.EnableEvents = True 'optionen wieder einschalten Application.ScreenUpdating = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Gerd,
das Rechteck ist leider nur teilweise gefüllt. Es handelt sich um eine Liste zur Bereitschaftsabfrage und in der Zeile darüber ist halt der lfd. Tag enthalten. Die Tabelle umfasst ein Jahr und dahinter soll halt gesammelt die Anzeige der Bereitschaftstage je Kollege (Zeile) erfolgen (zB 01.02., 05.04,...). Schon bei einem Schaltjahr ändert sich die Tabelle (Rechteck). Was meine Kollegin sonst noch ändert wird, kann ich nicht sagen. daher hatte ich die Hoffnung, dass es evtl. auch mit Formeln gehen könnte.
Leider bin ich nicht so dolle in VBA und habe keine Ahnung, wie man einem Bereich einen Namen zuweisen kann und diesen referenziert. Für ein kleines Beispiel wäre ich dankbar.
Grüße
Andreas

Hallo,
hab nun einen anderen Weg gefunden und eine Tabelle eingefügt, welche zur Abfrage dient. Nun ist das Makro, innerhalb der Tabele, dynamisch tätig und man kann die Tabelle vergrößern und verkleinern. Geht bestimmt noch hübscher und einfacher, aber besser kann ich es nicht. Evtl. ist dieser Weg auch das, was Gerd meinte^^


Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngRow As Long
Dim lngCol As Long
Dim rngZelle As Range
Application.ScreenUpdating = False 'optionen zum unterdrücken von ua anzeigeflimmern
Application.EnableEvents = False
x = ActiveCell.Address 'aktuelle zelle merken
Range("Tabelle6[#All]").Select 'tabelle auswählen
e = Selection.Cells(Selection.Count).Column 'letzte spalte ermitteln
y = Selection.Row 'erste reihe ermitteln
Z = Selection.Cells(Selection.Count).Row 'letzte reihe ermitteln
Range(Cells(y, e + 2), Cells(Z, e + 2)) = ""
For Each rngZelle In Selection.Cells 'tabelle abfragen
lngRow = rngZelle.Row
If lngRow > a Then vareintrag = "" 'bei neuer zeile variable löschen
lngCol = rngZelle.Column
a = lngRow
If rngZelle = "B" Or rngZelle = "b" Then
rngZelle = "B"
var_datum = Cells(y - 1, lngCol).Value 'wert bei übereinstimmung
If vareintrag  "" Then 'prüfen ob eintrag angehangen wird
vareintrag = vareintrag & ", " & Left(var_datum, 6) 'eintrag vornehmen, begrenzung  _
auf 6 stellen
Else
vareintrag = Left(var_datum, 6) 'eintrag auf 6 stellen begrenzt
End If
If var_datum  "" Then Cells(lngRow, e + 2).Value = vareintrag 'eintrag suchergebnis
End If
Next
Range(x).Select 'zur ausgangszelle zurück
Application.EnableEvents = True 'optionen wieder einschalten
Application.ScreenUpdating = True
End Sub

Grüße
Andreas

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread