Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1700to1704
1700to1704
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro zur auslesung eines Datums

Forumthread: Makro zur auslesung eines Datums

Makro zur auslesung eines Datums
05.07.2019 13:15:36
Robert
Hallo ich habe diesen Code um ein Datum aus einem bestimmten Bereich auszulesen und den Wert der unter dem Datum steht an einem definierten Ort auszugeben. Leider funktioniert das nur für eine Spalte bei der das Datum nicht als Tabelle formatiert ist. Da ich das Datum aus einer Tabelle auslesen möchte ist dies schlecht. Des weiteren soll nicht nur der erste Wert unter dem Datum kopiert und wo anders eingetragen werden, sondern das Datum selbst und eine fest definierte Anzahl von Feldern unter dem Datum die durch ein Eingabefenster bestimmt werden. Wäre super froh wenn ihr einen Ansatz habt um das ganze umzusetzen.
Option Explicit 
Public Sub Datum_Suchen()
Dim rngFind As Range
Dim strDate As String
strDate = InputBox("Datum:", , Date)
If strDate = "" Then Exit Sub
Set rngFind = Sheets("Spreads").Range("58:58").Find(DateValue(strDate), LookIn:= _
xlFormulas)
If Not rngFind Is Nothing Then
rngFind.Offset(1, 0).Copy
Sheets("Spreads2").Range("C95:C107").PasteSpecial
Application.CutCopyMode = False
Else
MsgBox "Das Datum wurde nicht gefunden!"
End If
End Sub

Anzeige

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro zur auslesung eines Datums
05.07.2019 13:54:38
Torsten
Hallo Robert,
warum machst du nicht in deinem anderen Beitrag weiter.
Hier der angepasste Code: 

Public Sub Datum_Suchen()
Dim rngFind As Range
Dim strDate As String
Dim a As Long, b As Long
strDate = InputBox("Datum:", , CDate(Date))
If strDate = "" Then Exit Sub
a = Sheets("Spreads").Cells(58, Columns.Count).End(xlToLeft).Column
Set rngFind = Sheets("Spreads").Range(Cells(58, 1), Cells(58, a)).Find(strDate, LookIn:= _
xlFormulas)
If Not rngFind Is Nothing Then
b = InputBox("Wieviele Zeilen sollen kopiert werden?", "Zeilen", "1")
Range(Cells(rngFind.Row, rngFind.Column), Cells(rngFind.Row + b, rngFind.Column)).Copy
Sheets("Spreads2").Range("C95").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Else
MsgBox "Das Datum wurde nicht gefunden!"
End If
End Sub
Gruss Torsten
Anzeige
AW: Makro zur auslesung eines Datums
05.07.2019 14:01:49
Torsten
Hallo,
bitte aendere diese Zeile ab 

Range(Cells(rngFind.Row, rngFind.Column), Cells(rngFind.Row + b, rngFind.Column)).Copy

in 

Sheets("Spreads").Range(Cells(rngFind.Row, rngFind.Column), Cells(rngFind.Row + b, rngFind. _
Column)).Copy

Anzeige
AW: Makro zur auslesung eines Datums
05.07.2019 14:39:38
Robert
Super,danke Torsten! Sry war etwas verwirrt.
Funktioniert genau wie beschrieben. Mir ist gerade aufgefallen, dass es sinnvoll wäre wenn die Zellen in die der Inhalt kopiert wird sich jedes mal nach rechts verschieben, sodas man Ende eine Auflistung von Daten hat. Wäre es möglich über eine weiteres Eingabe Feld abzufragen ob ein weiteres Datum gesucht wird, if yes soll es eingegeben werden und die Daten unter dem zweiten Datum sollen eine Spalte neben dem ersten Zielfeld platzieren werden.
Anzeige
AW: Makro zur auslesung eines Datums
08.07.2019 10:57:45
Robert
Kann mir jemand weiter helfen ?
AW: Makro zur auslesung eines Datums
08.07.2019 11:38:42
Torsten
Hallo Robert,
fast alles ist moeglich ;-) 

Public Sub Datum_Suchen()
Dim rngFind As Range
Dim strDate As String
Dim a As Long, b As Long, c As Long
strDate = InputBox("Datum:", , CDate(Date))
If strDate = "" Then Exit Sub
a = Sheets("Spreads").Cells(58, Columns.Count).End(xlToLeft).Column
Set rngFind = Sheets("Spreads").Range(Cells(58, 1), Cells(58, a)).Find(strDate, LookIn:= _
xlFormulas)
If Not rngFind Is Nothing Then
b = InputBox("Wieviele Zeilen sollen kopiert werden?", "Zeilen", "1")
Sheets("Spreads").Range(Cells(rngFind.Row, rngFind.Column), Cells(rngFind.Row + b,  _
rngFind.Column)).Copy
If Sheets("Spread2").Range("C95") = "" Then
Sheets("Spread2").Range("C95").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Else
c = Sheets("Spread2").Cells(95, Columns.Count).End(xlToLeft).Column
Sheets("Spread2").Cells(95, c + 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
Else
MsgBox "Das Datum wurde nicht gefunden!"
End If
End Sub
Gruss Torsten
Anzeige
AW: Makro zur auslesung eines Datums
08.07.2019 12:00:47
Robert
Vielen Dank !!
Wie schaffe ich es das falls nötig die Daten wieder in die erste Spalte eingetragen werden ?
AW: Makro zur auslesung eines Datums
08.07.2019 12:22:24
Torsten
Dann musst du alles loeschen. sonst wirds zu kompliziert
AW: Makro zur auslesung eines Datums
08.07.2019 13:07:29
Robert
Alles klar, danke nochmal !!
Anzeige
AW: Makro zur auslesung eines Datums
05.07.2019 14:28:30
fcs
Hallo Robert,
wenn die Datumswerte in der Überschrift einer Tabelle stehen, dann muss man nach dem Text des Datums suchen.
So sollte das Makro funktionieren. 
Public Sub Datum_Suchen()
Dim rngFind As Range
Dim strDate As String
Dim AnzZeilen As Long
strDate = InputBox("Datum:", , Date)
'ANzeilen, die kopiert werden sollen
AnzZeilen = Application.InputBox("Anzahl zu kopierender Zeilen", "Suchen und kopieren", 2,  _
Type:=1)
If strDate = "" Then Exit Sub
Set rngFind = Sheets("Spreads").Range("58:58").Find(Format(DateValue(strDate), _
"DD.MM.YYYY"), LookIn:=xlFormulas)
If Not rngFind Is Nothing Then
rngFind.Resize(AnzZeilen, 1).Copy
Sheets("Spreads2").Range("C95").PasteSpecial Paste:=xlPasteValues
With Sheets("Spreads2").Range("C95")
.Value = CDate(.Text)
End With
Application.CutCopyMode = False
Else
MsgBox "Das Datum wurde nicht gefunden!"
End If
End Sub

LG
Franz
Anzeige
;

Beliebteste Forumthreads (12 Monate)

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