Zeilen mit Wochenenden ermitteln

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Werner,
ich hatte mir vor Jahren einen Code zusammengebastelt welcher genau das ausführt das ich beschrieben habe, allerdings nicht für ein einzelnes Tabellenblatt, sondern es werden die Daten von mehreren Blättern ausgelesen. Wie schaffe ich es nun das gleiche auszuführen wenn alle Daten auf nur einem Sheet vorhanden sind?
"Test 2" - "Test 6" waren früher jeweils einzelne Sheets, in der Quelldatei stehen sie nun in Spalte H.
Unten findest du den verwendeten Code.
Viele Grüße
Marc


'Makro zum einlesen von Daten aus Quelldatei
Public Dateiname As Variant
Sub DateiWaehlenUndOeffnen()
'Dim Dateifilter As String
'Dim Dateiname As Variant
'Dateifilter = "Excel-Arbeitsmappen (*.xls),*.xls"
Dateiname = Application.GetOpenFilename(Dateifilter)
'If Dateiname  False Then
'MsgBox (Dateiname)
'End If
End Sub
Sub datei()
Dim WbDatei1 As Workbook
Dim WbDatei2 As Workbook
Dim i, j, k, zeilen As Integer
Dim modul(4)
Dim heute As Date
heute = Date                            'das heutige Datum
Call DateiWaehlenUndOeffnen             'oberes Makro zum Öffnen der Quelldatei aufrufen
Application.ScreenUpdating = False
Set WbDatei2 = ThisWorkbook
Set WbDatei1 = Workbooks.Open(Dateiname, ReadOnly:=True)
k = 1                                   'Laufvariable im aktiven Excelblatt
modul(0) = "Test 2"                     'Belegung der verschiedenen Bezeichnungen als Array
modul(1) = "Test 3"
modul(2) = "Test 4"
modul(3) = "Test 5"
modul(4) = "Test 6"
'erste Schleife zur Bestimmung des korrekten Blattes in der Quelldatei
For j = 0 To 4
zeilen = WbDatei1.Sheets(modul(j)).Cells(Rows.Count, 15).End(xlUp).Row
For i = 1 To zeilen
'Das ausgelesene Datum soll größer sein als das heute Datum und kleiner als eine Woche
If WbDatei1.Sheets(modul(j)).Cells(i, 15).Value > heute - 1 And WbDatei1.Sheets(modul(j)).Cells(i, 15).Value

wtih Workbooks("Quelldatei.xlsx").Sheets("Orders").Usedrange .with .Columns(.Columns.Count + 1) .FormulaR1C1 = "=IfError(If(WeekDay(RC15,2)>=5,1,""""),"") '5=Freitag if Worksheetfunction.Sum(.Cells) > 0 then Intersect(.SpecialCells(xlcelltypeformulas, 1).EntireRow, .Worksheet.Range("B:B,E:F,H:H,O:O")).Copy ThisWorkbook.Sheets(?).Cells(...).PasteSpecial xlpasteall end if end if end with Workbooks("Quelldatei.xlsx").close false

'Makro zum einlesen von Daten aus Quelldatei Public Dateiname As Variant Sub DateiWaehlenUndOeffnen() 'Dim Dateifilter As String 'Dim Dateiname As Variant 'Dateifilter = "Excel-Arbeitsmappen (*.xls),*.xls" Dateiname = Application.GetOpenFilename(Dateifilter) 'If Dateiname False Then 'MsgBox (Dateiname) 'End If End Sub Sub datei() Dim WbDatei1 As Workbook Dim WbDatei2 As Workbook Dim i, j, k, zeilen As Integer Dim modul(4) Dim heute As Date heute = Date 'das heutige Datum Call DateiWaehlenUndOeffnen 'oberes Makro zum Öffnen der Quelldatei aufrufen Application.ScreenUpdating = False Set WbDatei2 = ThisWorkbook Set WbDatei1 = Workbooks.Open(Dateiname, ReadOnly:=True) k = 1 'Laufvariable im aktiven Excelblatt modul(0) = "Test 2" 'Belegung der verschiedenen Bezeichnungen als Array modul(1) = "Test 3" modul(2) = "Test 4" modul(3) = "Test 5" modul(4) = "Test 6" 'erste Schleife zur Bestimmung des korrekten Blattes in der Quelldatei For j = 0 To 4 zeilen = WbDatei1.Sheets(modul(j)).Cells(Rows.Count, 15).End(xlUp).Row For i = 1 To zeilen 'Das ausgelesene Datum soll größer sein als das heute Datum und kleiner als eine Woche If WbDatei1.Sheets(modul(j)).Cells(i, 15).Value > heute - 1 And WbDatei1.Sheets(modul(j)).Cells(i, 15).Value

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread