Makro zur auslesung eines Datums

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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

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

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro zur auslesung eines Datums

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

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread