Live-Forum - Die aktuellen Beiträge
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
Inhaltsverzeichnis

aktuelle Geb. in diesem Jahr auswerten

aktuelle Geb. in diesem Jahr auswerten
09.04.2015 12:15:15
Kathi
Hallo zusammen,
ich habe hier eine Tabelle1 die den Namen, Geb. ... enthält
Userbild
Nun möchte ich, dass eine InputBox erscheint, die nach dem Jahr fragt, das ausgewertet werden soll. Das ist noch kein Problem und klappt. Aber dann steh ich an :-(
Nachdem ich nach dem Jahr 1962 gesucht habe, sollte die Tabelle 2 so aussehen:
Userbild
Ich hab einen Knopf im Kopf... bitte um Hilfe!!!
Option Explicit
Sub Eintragen()
Dim Dat As Variant
Dat = InputBox("Geben Sie ein Jahr ein!")
'Wenn Personen aus dem eingegeben Jahr Geburtstag haben, sollen die Nachnamen und Vornamen in   _
_
der Tabelle2 aufscheinen, das ganze ist bei mir noch auf eine Zelle beschränkt, soll aber  _
flexibel sein!
If Dat = Year(Cells(4, 2)) Then
Sheets("Tabelle2").Cells(1, 1) = Sheets("Tabelle1").Cells(2, 1)
End If
End Sub

Danke schon im Voraus!
Liebe Grüße Kathi

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: aktuelle Geb. in diesem Jahr auswerten
09.04.2015 12:25:15
Klaus
Hi Kathi,
auf die schnelle - Tabellennamen und so weiter bitte selber anpassen.
Option Explicit
Sub Aus1Nach2()
Dim r As Range
Dim lRow1 As Long
Dim lRow2 As Long
Dim Dat As Variant
Dat = InputBox("Geben Sie ein Jahr ein!")
If Not IsNumeric(Dat) Then
MsgBox ("Das ist kein Jahr! Abbruch...")
Exit Sub
End If
With Sheets("Tabelle2")
lRow2 = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End With
With Sheets("Tabelle1")
lRow1 = .Cells(.Rows.Count, 4).End(xlUp).Row
For Each r In .Range(.Cells(2, 4), .Cells(lRow1, 4))
If Year(r.Value) = --Dat Then
.Range(.Cells(r.Row, 1), .Cells(r.Row, 4)).Copy
Sheets("Tabelle2").Cells(lRow2, 1).PasteSpecial
lRow2 = lRow2 + 1
Application.CutCopyMode = False
End If
Next r
End With
End Sub
Grüße,
Klaus M.vdT.

Anzeige
schnellere Version
09.04.2015 12:32:49
Klaus
Hallo Kathi,
meine erste Lösung ist bei großen Datenmengen mit tausenden von Einträgen bestimmt kriechend langsam. Hier eine optimierte Version:
Option Explicit
Sub Aus1Nach2_Beschleunigt()
Dim r As Range
Dim lRow1 As Long
Dim lRow2 As Long
Application.ScreenUpdating = False
Dim Dat As Variant
Dat = InputBox("Geben Sie ein Jahr ein!")
If Not IsNumeric(Dat) Then
MsgBox ("Das ist kein Jahr! Abbruch...")
Exit Sub
End If
With Sheets("Tabelle1")
lRow1 = .Cells(.Rows.Count, 1).End(xlUp).Row
If .AutoFilterMode Then .Cells.AutoFilter
.Range(.Cells(1, 1), .Cells(lRow1, 4)).AutoFilter
.Range("A1:D1").AutoFilter Field:=4, Operator:=xlFilterValues, Criteria2:=Array(0, "1/1/" &  _
Dat)
On Error GoTo hell
.Range("A2:D" & lRow1).SpecialCells(xlCellTypeVisible).Copy
On Error GoTo 0
End With
With Sheets("Tabelle2")
lRow2 = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Range("A" & lRow2).PasteSpecial
End With
GoTo heaven
hell:
MsgBox ("Keine Auswahl möglich!")
heaven:
Sheets("Tabelle1").Cells.AutoFilter
Application.ScreenUpdating = True
End Sub
LG
Klaus M.vdT.

Anzeige
AW: aktuelle Geb. in diesem Jahr auswerten
09.04.2015 12:25:37
Rudi
Hallo,
warum filterst du die Tabelle nicht einfach nach dem Jahr?
Gruß
Rudi

und es muß VBA sein? ...
09.04.2015 12:27:07
der
Hallo Kathi,
... ich frage deshalb, weil man das auch mit einer Dropdownzelle und Formel(n) lösen könnte.
Gruß Werner
.. , - ...

AW: aktuelle Geb. in diesem Jahr auswerten
09.04.2015 12:37:07
Kathi
Lieber Klaus,
Lieber Rudi,
Lieber neopa,
danke für eure raschen Antworten.
@ Klaus ... super vielen dank und vor allem, dass du es noch einmal überarbeitet hast. Es sind gott sei dank nur um die 70 Datensätze. Werde es gleich testen :)
@ Rudi und neopa ... ja das wäre ja zu einfach ... das gefällt dem Herrn Vorgesetzen nicht. Wie gut, dass ich hier gar nicht für die EDV angestellt bin, aber man es von mir erwartet.
Liebe Grüße

Anzeige
Danke für die Rückmeldung! bei 70 ...
09.04.2015 12:39:05
Klaus
.... Datensätzen nimm aber die Version 1, die ist leichter nachvollziehbar und damit für den Laien besser anzupassen und zu pflegen. Bei 70 Einträgen und einem modernen Prozessor in der Kiste dürfte der Unterschied unter einer Sekunde Laufzeit betragen.
Grüße,
Klaus M.vdT.

AW: Danke für die Rückmeldung! bei 70 ...
09.04.2015 12:45:35
Kathi
...darf ich vielleicht noch eine unverschämte Frage stellen? :)
Wie würde man das schreiben, wenn es in einer MsgBox ausgegeben werden soll? Also gar nicht im Tabellenblatt2 sondern direkt in der MsgBox?
Liebe Grüße Kathi

Namen in einer MsgBox ausgeben
09.04.2015 13:18:53
Kathi
Klaus war so nett und hat mir verraten, wie ich die Daten in ein zweites Tabellenblatt bekomme, aber wie Frauen nunmal so sind, hab ich meine Meinung geändert ;-) und hätte die Ausgabe jetzt bitte gerne in einer MsgBox. Ich weiß aber leider nicht, wie man das umsetzt. Eine einfache MsgBox (die sich auf bestimmte Zellen bezieht) kann ich erstellen, aber keine, in der es mir die Daten anzeigt, die ich gerade abgefragt habe, ohne dass diese Daten in irgendeinem Tabellenblatt aufscheinen.

Anzeige
Kein Problem :-)
09.04.2015 13:19:34
Klaus
Hi Kathi,
den Text kannst du noch anpassen. Chr(10) ist der Zeilenumbruch, der Rest ist Textverkettung mit &.
Sub Aus1Nach2_BeschleunigtMsgBox()
Dim r As Range
Dim lRow1 As Long
Dim lRow2 As Long
Dim MsgTxt As String
Application.ScreenUpdating = False
Dim Dat As Variant
Dat = InputBox("Geben Sie ein Jahr ein!")
If Not IsNumeric(Dat) Then GoTo hell
MsgTxt = "Geburtstage im Jahr " & Dat & ":" & Chr(10) & Chr(10)
With Sheets("Tabelle1")
lRow1 = .Cells(.Rows.Count, 1).End(xlUp).Row
If .AutoFilterMode Then .Cells.AutoFilter
.Range(.Cells(1, 1), .Cells(lRow1, 4)).AutoFilter
.Range("A1:D1").AutoFilter Field:=4, Operator:=xlFilterValues, Criteria2:=Array(0, "1/1/" &  _
Dat)
On Error GoTo hell
For Each r In .Range("A2:A" & lRow1).SpecialCells(xlCellTypeVisible)
MsgTxt = MsgTxt & .Cells(r.Row, 1) & ", "
MsgTxt = MsgTxt & .Cells(r.Row, 2) & " / "
MsgTxt = MsgTxt & .Cells(r.Row, 3) & ", ist geboren am: "
MsgTxt = MsgTxt & .Cells(r.Row, 4) & Chr(10)
Next r
On Error GoTo 0
End With
MsgBox MsgTxt
GoTo heaven
hell:
MsgBox ("Keine Auswahl möglich!")
heaven:
Sheets("Tabelle1").Cells.AutoFilter
Application.ScreenUpdating = True
End Sub
Grüße,
Klaus M.vdT.

Anzeige
AW: Danke für die Rückmeldung! bei 70 ...
09.04.2015 13:23:01
Rudi
Hallo,
klar geht das.
Sub Aus1Nach2()
Dim r As Range
Dim lRow1 As Long
Dim lRow2 As Long
Dim strGeb As String
Dim Dat As Variant
Dat = InputBox("Geben Sie ein Jahr ein!")
If Not IsNumeric(Dat) Then
MsgBox ("Das ist kein Jahr! Abbruch...")
Exit Sub
End If
With Sheets("Tabelle1")
lRow1 = .Cells(.Rows.Count, 4).End(xlUp).Row
For Each r In .Range(.Cells(2, 4), .Cells(lRow1, 4))
If Year(r.Value) = --Dat Then
strGeb = strGeb & vbLf & r.Offset(, -3) & ", " & r.Offset(, -2) & ": " & r.Text
End If
Next r
End With
strGeb = Mid(strGeb, 2)
If Len(strGeb) = 0 Then strGeb = "Keine Geburtstage"
MsgBox strGeb, , "Geburtstage " & Dat
End Sub

Gruß
Rudi

Anzeige
...the ultimate autofilter overkill ;-) (owT)
09.04.2015 13:50:01
EtoPHG

AW: ...the ultimate autofilter overkill ;-) (owT)
09.04.2015 14:51:58
Kathi
Warum funktioniert der Code nicht, wenn in einer Zelle kein Datum geschrieben steht sondern eine Formel? Was muss ich da ändern?
Konkret geht es darum, dass ich in der Zelle kein Geburtstag stehen habe, sondern z.B. das 10 jährige Jubiläum und das berechnet sich aus dem Geburtstag + 10 Jahre, oder das 20 jährige oder was auch immer.

Code funktioniert nicht, wenn Datum = Formel
09.04.2015 15:01:10
Kathi
Warum funktioniert der Code nicht, wenn in einer Zelle kein Datum geschrieben steht sondern eine Formel? Was muss ich da ändern?
Konkret geht es darum, dass ich in der Zelle kein Geburtstag stehen habe, sondern z.B. das 10 jährige Jubiläum und das berechnet sich aus dem Geburtstag + 10 Jahre, oder das 20 jährige oder was auch immer.

Anzeige
Weil du uns nicht die Wahrheit offenbarst
09.04.2015 15:04:03
EtoPHG
Kathi,
Was glaubst du ist der Unterschied zwischen
"06.04.1965" und "50 jähriges Jubiläum" ?
Nach welcher Jahreszahl würdest du im 1ten Fall suchen, nach welcher im 2ten?
Ob der Inhalt durch eine Formel entsteht spielt dabei überhaupt kein Tango, aber nach was gesucht werden soll sehr wohl. Wenn du, oder dein Vorgesetzter, schon VBA-Code verlangst, sollten sich die Helfer auf wahrheitsgetreue Angaben verlassen können und weder auf Bildchen und schon gar nicht auf Bildchen, die nicht der echten Darstellung im Excel entsprechen.
Geh nochmals über die Bücher und lade eine anonymisierte Beispielmappe hoch, die
a) genau dem Datenstruktuer und Formeln deiner echten Mappe entsprechen
b) in einem zusätzlichen Blatt die Anforderungen an den Ablauf bzw. die Prozedur beschreiben.
Gruess Hansueli

Anzeige
AW: Weil du uns nicht die Wahrheit offenbarst
09.04.2015 15:11:50
Kathi
Nein, da reden wir gerade aneinander vorbei.
So sieht es aus:
Userbild
Das steckt dahinter:
Userbild

Das wir aneinander vorbeireden
09.04.2015 15:22:11
EtoPHG
ist richtig, Kathi,
denn nun zeigst du uns eine Formel in der Spalte 2 (B) die von einem Datumswert in Spalte 1 (A) Daten bezieht und dabei das Jahr um 10 erhöht.
Was willst du uns damit sagen?
Das der Code (von Rudi) in einer falschen Spalten ein Jahr sucht (nämlich in Spalte 4 = D)?
Das er das (gesuchte) Jahr 1997 in Spalte A nicht findet, oder das (gesuchte) Jahr 1987 in Spalte B?
Lies die Fragen genau!
Glaubst du wirklich du kommst zu einer lauffähigen Lösung, wenn du uns mit Bildchen und tröpfchenweisen Infos fütterst?
Beispielmappe, bitte! (siehe vorherige Antwort von mir)
Gruess Hansueli

Anzeige
Es klappt!
09.04.2015 15:41:01
Kathi
Den Code von Rudi hab ich schon umgebastelt und es klappt auch super!!! Allerdings nur solange, solange ich das Datum händisch eingebe. Sobald eine Formel im Hintergrund abläuft, bekomm ich die Meldung "Typen unverträglich" mit dem Hinweis auf If Year(r.Value) = --Dat Then.
Hab jetzt nochmal alles in eine andere Mappe gespeichert und auf einmal gehts. Hm seltsam, keine Ahnung woran es jetzt lag.
FYI: Konnte keine Beispielmappe hochladen, weil die gesamte Mappe größer ist als erlaubt, weil sie wesentlich komplexer ist. Das hier ist nur ein kleiner Teil, der sich aus anderen Teilen ergibt. Aber danke für deine Rückmeldungen.
Schönen Tag noch!!

AW: Danke für die Rückmeldung! bei 70 ...
09.04.2015 13:51:39
Kathi
Wahnsinn!!! Danke!!!
Mein Problem ist, dass ich ja grunsätzlich den Code verstehe, nur selbst nei auf diese Lösungen komme. :( Danke nochmal an alle, die mir geantwortet haben.

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige