Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1948to1952
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

Datumseinträge vergleichen

Datumseinträge vergleichen
03.10.2023 09:54:30
Chrisi
Hallo zusammen,

ich bräuchte ganz dringend Hilfe von euch bei einem Arbeitsschritt worauf ich einfach keine Lösung finde. Gemacht werden soll folgendens:

1) Im Sheet "Materialdeckung" gibt es einen Bereich (welcher sich bei jedem Makrostart ändern kann) worin Datumseinträge stehen, angefangen bei Zelle "J11" dieser Bereich geht in der gleichen Zeile nach rechts weiter (J11, K11, L11......), sprich der Bereich fängt immer bei "J11" an hört aber nicht immer bei der gleichen Zelle auf da der Benutzer bei Makrostart eine Zahl eingeben kann welche angibt wie viele Tage (Datumseinträge) er in dieser Liste sehen möchte. In diesem Tabellenblatt sind die Einträge Tag für Tag sprich 1.10.2023, 2.10.2023, 3.10.2023....... angegeben

2) Im Sheet "COP_ Stock vs. OO ") gibt es ebenfalls Datumseinträge (angefangen ebenfalls bei "J11"), in diesem Blatt sind die Einträge aber nicht Tag für Tag sondern eher so:
2.10.2023, 5.10.2023, 6.10.2023, 10.10.2023, 13.10.2023..... also zufällig, es gibt keine fixe Reihenfolge.

Meine Idee für den Ablauf wäre folgender:

Im Sheet "Materialdeckung" wird der erste Datumseintrag auf eine Variable gespeichert, dann wird das Sheet "COP_ Stock vs. OO " ausgewählt und ebenfalls der erste Datumseintrag auf eine Variable geschrieben. Die beiden Variablen werden anschließend miteinander überprüft:

IF:
Wenn diese übereinstimmen, soll die ganze Spalte der aktiven Zelle des Sheets "COP_ Stock vs. OO " kopiert und bei "Materialdeckung" bei der Spalte mit dem vorher gemerktem Datum eingefügt werden und dann in die nächste Zelle mit nächsten Datumseintrag und dann genau das gleiche wieder und das so lange bis alle Datumseinträge von "Materialdeckung" fertig sind.

Else:
Sollten die Datumseinträge nicht übereinstimmen soll in Sheet "COP_ Stock vs. OO " das nächste Datum auf die Variable gespeichert werden und geschaut werden ob dieses Datum passend ist, wenn es wieder nicht passt, soll wieder eine Zelle weiter gegangen werden und das so immer weiter

Ich hoffe ich habe das halbwegs verständlich erklärt xD, zur besseren Verständnis findet ihr eine BeispielDatei im Anhang.
https://www.herber.de/bbs/user/163219.xlsm

Hoffe mir kann dabei jemand helfen.

Hier noch mein Code bis jetzt:

Sub CopySheets()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim strSkip As String
Dim wsh As Worksheet
Dim Zelle As Range
Dim Lrow1 As Integer
Dim i As Integer
Dim zeilenanzahl As Integer
Dim Dateipfad As String
Dim EndeVonDatum As String
Dim EndeVonSpalten As String
Dim zelles As Range
Dim bereichs As Range
Dim Datum As Date
Dim MaterialdeckungDatum As Date
Dim CopstockDatum As Date

Dateipfad = Sheets("Start").Range("A15").Value
zeilenanzahl = InputBox("Wie viele Tage sollen gelistet werden? (inklusive heute)")


'nicht benötigte tabellen löschen
strSkip = "Start, Materialdeckung"
For Each wsh In Worksheets
If InStr(strSkip, wsh.Name) = 0 Then
wsh.Delete
End If
Next

Sheets("Materialdeckung").Activate
Worksheets("Materialdeckung").Rows(9 & ":" & Worksheets("Materialdeckung").Rows.Count).Delete

'Datei auswählen und importieren
Dim fd As FileDialog, Lrow As Long, vSelectedItem As Variant, srcWB As Workbook, desWB As Workbook
Set desWB = ThisWorkbook
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = True
.InitialFileName = Dateipfad
If .Show = -1 Then
For Each vSelectedItem In .SelectedItems
Set srcWB = Workbooks.Open(vSelectedItem)
ActiveSheet.Name = Left(ActiveWorkbook.Name, 18)
Sheets(1).Copy after:=desWB.Sheets(desWB.Sheets.Count)
srcWB.Close False
Next
End If
End With

Sheets("COP_ Stock vs. OO ").Activate
Range("A9:H28").Select
Selection.Copy
Sheets("Materialdeckung").Activate
Range("A10").Select
ActiveSheet.Paste
Rows("11:11").Select
Selection.Delete Shift:=xlUp
Sheets("COP_ Stock vs. OO ").Activate
Range("I11:I28").Select
Selection.Copy
Sheets("Materialdeckung").Activate
Range("I11").Select
ActiveSheet.Paste
Sheets("COP_ Stock vs. OO ").Activate
Range("V10:V28").Select
Selection.Copy
Sheets("Materialdeckung").Activate
Range("J11").Select
ActiveSheet.Paste

'Datumseinträge generieren
For i = 1 To zeilenanzahl Step 1
Columns("J:J").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Next i
Range("J11").Select
ActiveCell.Value = Date
EndeVonDatum = ActiveCell.Offset(0, zeilenanzahl - 1).Address
If EndeVonDatum = "$J$11" Then
Columns("J:J").EntireColumn.AutoFit
Else
Selection.AutoFill Destination:=Range("J11:" & EndeVonDatum)
Columns("J:CZ").EntireColumn.AutoFit
End If

'datum anpassen - .
Sheets("COP_ Stock vs. OO ").Activate
Range("J11").Select
Do While ActiveCell.Value > "OB+FC Qty Total"
ActiveCell.Value = Replace(ActiveCell.Value, "-", ".")
ActiveCell.Offset(0, 1).Select
Loop
End Sub


Vielen Dank im vorhinein
LG Chrisi

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datumseinträge vergleichen
03.10.2023 11:34:06
Alwin Weisangler
Hallo Chrisi,

Um Datumswerte zu vergleichen, müssen diese auch ein Datum sein. Leider waren manche Text und manche ein echtes Datum. Ich habe das korrigiert.


Option Explicit

Sub DatumspalteUebertragen()
Dim arr(), i&, j&, k&, zStart&, zEnde&
With Tabelle1 ' Datumsbereich erfassen
For i = 1 To .Cells(11, Columns.Count).End(xlToLeft).Column
If .Cells(11, i) = "i.p." Then zStart = i + 1
If .Cells(11, i) = "OB+FC Qty Total" Then
zEnde = i - 1
Exit For
End If
Next i
arr = .Range(.Cells(11, zStart), .Cells(28, zEnde)).Value ' Datumsbereich nebst Werte der Spalte in Array laden
End With
With Tabelle6
For i = 1 To UBound(arr, 2) ' i Schleife Datumswerte des Arrays abklappern
For j = 10 To 100 ' j Schleife Datumswerte der Zieltabelle abklappern
If .Cells(11, j) = "" Then Exit For
If arr(1, i) = .Cells(11, j) Then ' Bei Übereinstimmung zw. Array und Zelle dann...
For k = 1 To UBound(arr, 1) ' k Schleife Übergabe der Werte in die Zielspalte
.Cells(10 + k, j) = arr(k, i)
Next k
Exit For
End If
Next j
Next i
End With
End Sub

Teste mal.
https://www.herber.de/bbs/user/163220.xlsm
Gruß Uwe


Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige