Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
532to536
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
532to536
532to536
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Montag und Freitag aus KW bestimmen

Montag und Freitag aus KW bestimmen
20.12.2004 10:57:05
Harald
Hallo Forum,
mit folgendem Code hole ich mir Daten, die gewisse Merkmale aufweisen und in einem Zeitrahmen liegen, in ein neues Blatt.

Sub subBF()
Dim lgQuell As Long
Dim lgZiel As Long
If Cells(1, 13) Or Cells(1, 14) = "" Then
MsgBox "Datum eintragen"
Exit Sub
End If
Sheets.Add.Name = "BF"
Sheets("Erfassung").Select
For lgQuell = 1 To Range("A500").End(xlUp).Row
If Cells(lgQuell, 2) Like "*M" And Cells(lgQuell, 10) Like ("BF")
And Cells(lgQuell, 3) >= Cells(1, 13) And Cells(lgQuell, 3) <= Cells(1, 14) Then
lgZiel = lgZiel + 1
Rows(lgQuell).Copy Sheets("BF").Rows(lgZiel)
End If
Next
End Sub

Der geneigte Spezialist erkennt sofort...Da kann man was verbessern. ;-))
Und zwar möchte ich erreichen, dass ich nur die gewünschte Kalenderwoche eingebe
und er mir daraus resultierend die relevanten Daten von Montag bis Freitag dieser KW kopiert.
Bisher muss ich Montag und Freitag der Kalenderwoche händisch eintragen.
Gruß
Harald

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Montag und Freitag für Monat
Peter
Ich hoffe es hilft weiter.
Peter

Sub Dienst_Freitage_imMonat()
Dim Jahr As Integer
Dim Monat As Date, Mon As Byte
Dim i As Byte
Dim x As Integer
Application.ScreenUpdating = False
Jahr = Year(Date)
Mon = Month(Date)
'Monatsblatt anlegen
Sheets.Add before:=Worksheets(1)
Monat = DateSerial(Jahr, Mon, 1)
ActiveSheet.Name = Format(Monat, "mmm yy")
'Dienstage eintragen
For i = 1 To 31
If Weekday(DateSerial(Jahr, Mon, i)) = 2 Then 'Mo
Cells(3, 2 + x) = DateSerial(Jahr, Mon, i)
Cells(3, 1).Value = "Montag"
End If
If Weekday(DateSerial(Jahr, Mon, i)) = 6 Then 'Fr
Cells(4, 2 + x) = DateSerial(Jahr, Mon, i)
Cells(4, 1).Value = "Freitag"
x = x + 1
End If
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Montag und Freitag für Monat
20.12.2004 11:51:58
Harald
Hallo Peter,
in der Tat. Der Code ist hilfreich. Vielen Dank dafür.
Für mein spezielles Problem hab ich allerdings noch eine Frage.
Wenn ich zum Beispiel KW 49 auswerten will, soll er mir die Daten für diese KW auswählen.
D.h. entweder trage ich 49 in eine Zelle oder in eine Inputbox ein.
Basierend auf dem eingegebenen Wert soll er mir von Mo-Fr kopieren.
Gruß
Harald
Hilfsspalte mit KW einfügen o.T.
20.12.2004 14:10:57
Harald
...und dann nach KW in Hilfsspalte filtern
AW: Hilfsspalte mit KW einfügen o.T.
Peter
Hallo Harald,
dies hab ich bei "Herber" gefunden. Ich hoffe es hilft weiter.
Frage: Wie kann ich den ersten Tag einer beliebigen Kalenderwoche in einem beliebigen Jahr ermitteln.
Antwort: Die nachfolgenden benutzerdefinierten Funktionen in ein StandardModul einfügen. Aufrufsyntax, wenn das Jahr in D2 und die Wochen-: nummer in A2 stehen: =Dinday($D$2;A2)
'StandardModule: basMain

Private Function DINWeek(dat As Date) As Integer
Dim dbl As Double
dbl = DateSerial(Year(dat + (8 - WeekDay(dat)) Mod 7 - 3), 1, 1)
DINWeek = (dat - dbl - 3 + (WeekDay(dbl) + 1) Mod 7) \ 7 + 1
End Function

Function DINDay(intYear As Integer, intDIN As Integer)
Dim intDay As Integer, intWeek As Integer
If intYear = 0 Then
DINDay = 0
Exit Function
End If
intDay = 1
intWeek = DINWeek(DateSerial(intYear, 1, 1))
If intWeek 1 Then
Do Until DINWeek(DateSerial(intYear, 1, intDay)) = 1
intDay = intDay + 1
Loop
Else
Do Until DINWeek(DateSerial(intYear, 1, intDay)) 1
intDay = intDay - 1
Loop
intDay = intDay + 1
End If
DINDay = DateSerial(intYear, 1, intDay) + (intDIN - 1) * 7
End Function
Anzeige
Menno...wie peinlich
21.12.2004 07:30:26
Harald
Hi Peter,
danke für die Mühen.
Dabei hab ich die CD von Hans auch.
Gruß
Harald

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige