KW aus Worksheetnamen in Zelle "D23" übernehmen

Dieses Thema KW aus Worksheetnamen in Zelle "D23" übernehmen im Forum "Microsoft Office Suite" wurde erstellt von falcon30, 11. Dez. 2006.

Thema: KW aus Worksheetnamen in Zelle "D23" übernehmen Hallo Zusammen, brauche mal wieder Hilfe. Ich habe folgendes Problem: Ich habe für das Jahr 2007 mir in Excel 52...

  1. Hallo Zusammen,

    brauche mal wieder Hilfe.

    Ich habe folgendes Problem:
    Ich habe für das Jahr 2007 mir in Excel 52 Worksheets angelegt.
    Diese sind entsprechend Kalenderwoche benannt, d.h. KW1 bis KW52.

    Ich würde gerne in der Spalte D23 nun folgendes haben:
    z.B. für Worksheet KW1 -> Zelle D23 mit folgendem Inhalt: 01.01. - 07.01.06

    Kann mir da jemand helfen??

    Vielen Dank im Voraus!!

    Grüße
    Sahin Duygun
                           

       
     
  2. Hallo,

    eine Umkehrung habe ich noch nicht hinbekommen! Aber vielleicht hilft das
    einen kleinen Schritt weiter:

    Code:
    MsgBox Format(Weekday(02.01.2007, vbUseSystemDayOfWeek), KW: ww)
    
     
  3. Hallo Fibonacci,

    Makro-Lösung hab ich vergessen einzutragen  ::)

    Gruß Matjes :)
    Code:
    Option Explicit
    '*************************************************
    '*** Regel der Berechnung der Kalenderwoche nach deutscher Regelung:
    '*** KW1 im Jahr ist die Woche, die den ersten Donnerstag des Jahres enthält,
    '*** mit anderen Worten - die erste Woche hat mindestens 4 Tage.
    '*** KW53 ist vorhanden, wenn 4 Tage im gleichen Kalenderjahr liegen
    
    Private Type KWAnfEnde_struct
      dDateAnf    As Date
      dDateEnde   As Date
      bVorhanden  As Boolean
    End Type
    
    Sub KWStringAnfEndeInD23()
      
      Const cRANGE_DATUM = D23
      Const cBLTNAME_ANFANG = KW
      
      Dim wb As Workbook, ws As Worksheet
      Dim KWs(1 To 53) As KWAnfEnde_struct
      Dim lJahr As Long, sStr As String, x As Long
      
      If Not EingabeJahr(lJahr) Then GoTo AUFRAEUMEN
      
      Call KWs_DatumAnfangEndeBerechnen(lJahr, KWs)
      
     ->Datumstring in D23 der KW-Blätter der aktuellen Mappe eintragen
     ->Form: 01.01. - 07.01.06
      Set wb = ActiveWorkbook
      For x = LBound(KWs()) To UBound(KWs())
        Set ws = Nothing
        On Error Resume Next
        If KWs(x).bVorhanden Then
         ->Datumsstring in KW-Blatt eintragen
          Set ws = wb.Worksheets(cBLTNAME_ANFANG & x)
          Err.Clear: On Error GoTo 0
          If ws Is Nothing Then
            MsgBox Datum konnte auf Blatt-> & cBLTNAME_ANFANG & x &-> nicht eingetragen werden.
            GoTo AUFRAEUMEN
          End If
          sStr = _
            Format(Day(KWs(x).dDateAnf), 00) & . & _
            Format(Month(KWs(x).dDateAnf), 00) & . & _
             -  & _
            Format(Day(KWs(x).dDateEnde), 00) & . & _
            Format(Month(KWs(x).dDateEnde), 00) & . & _
            Right(Format(Year(KWs(x).dDateEnde), 00), 2)
          With ws.Range(cRANGE_DATUM): .NumberFormat = @: .Value = sStr: End With
        Else
          Set ws = wb.Worksheets(cBLTNAME_ANFANG & x)
          Err.Clear: On Error GoTo 0
          If Not ws Is Nothing Then
            MsgBox cBLTNAME_ANFANG & x &  ist im Jahr  & lJahr &  nicht exisitent.
          End If
        End If
      Next
      
    AUFRAEUMEN:
      Set ws = Nothing: Set wb = Nothing
    End Sub
    
    '**************************************************************************************
    Private Function KWs_DatumAnfangEndeBerechnen(lJahr As Long, KWs() As KWAnfEnde_struct)
    
     ->Liefert Anfangs und Enddatum der KW1-53 des Jahres
     ->KW53 ist vorhanden, wenn 4 Tage im gleichen Kalenderjahr liegen
    
      Dim lTag As Long, lMonat As Long, x As Long
      Dim dDate As Date, dDateJahresanfang As Date, dDateJahresende As Date
      
     ->Anfangsdatum der KW1 feststellen
      dDateJahresanfang = 1.1. & lJahr
      dDate = 1.1. & lJahr
      Do
        If WeekDay(dDate) = vbSunday And _
           DateDiff(d, dDateJahresanfang, dDate) >= 3 Then Exit Do
        dDate = DateAdd(d, 1, dDate)
      Loop
      KWs(1).dDateAnf = DateAdd(d, -6, dDate)
      If Month(KWs(1).dDateAnf) <> 1 Then KWs(1).dDateAnf = dDateJahresanfang
      
     ->EndeDatum der KW1
      KWs(1).dDateEnde = dDate
      KWs(1).bVorhanden = True
      
     ->Anfangs und Enddatum für KW2-53 berechnen
      For x = 2 To 53
        KWs(x).dDateAnf = DateAdd(d, 1, KWs(x - 1).dDateEnde)
        KWs(x).dDateEnde = DateAdd(d, 6, KWs(x).dDateAnf)
        KWs(x).bVorhanden = True
      Next
      
     ->KW53 prüfen, ob mindestens 4 Tage im Jahr liegen
      dDateJahresende = 31.12. & lJahr
      If DateDiff(d, KWs(53).dDateAnf, dDateJahresende) < 3 Then KWs(53).bVorhanden = False
      
    End Function
    
    '**************************************************************************************
    Private Function EingabeJahr(lJahr As Long) As Boolean
    
      Dim s As String
      
      s = Year(Now())->vorbesetzen mit aktuellem Jahr
      
      Do
        s = InputBox( _
          Bitte geben sie das Jahr vierstellig ein., _
          Eingabe Jahr für KW-String in KW-Blätter(D23) eintragen., _
          s)
        If s =  Then Exit Function
        On Error Resume Next
        lJahr = s
        If Err.Number <> 0 Then
          Err.Clear: On Error GoTo 0: MsgBox Eingabe unzulässig.
        Else
          On Error GoTo 0
          If lJahr < 2000 And lJahr > 2038 Then
            MsgBox _
             Eingabe unzulässig. & vbLf & _
             Bitte Jahreszahl zwischen 2000 und 2038 angeben.
          Else
           ->Eingabe ok
            EingabeJahr = True
            Exit Do
          End If
        End If
      Loop
      
    End Function
     
  4. Moin Matjes,

    den werde ich mir mal in mein Archiv packen. THX

    Wie ist das - eine direkte Syntax für KW-Nr gibt es wohl nicht - oder? Wobei ich das nicht
    verstehe, da sich ja im Format die KW auslesen lässt. Somit ist die Info ja irgenwo schon
    da... Hmmm wie auch immer...

    Einen guten Start ins neue Jahr
     
  5. Hallo Matjes,

    nochmals vielen Dank!!

    Grüße
    falcon30
     
Die Seite wird geladen...

KW aus Worksheetnamen in Zelle "D23" übernehmen - Ähnliche Themen

Forum Datum
Einzelne Zellen in Spalte bedingt Formatieren Microsoft Office Suite 16. Mai 2016
Hintergrundfarbe hinter ausgeblendeten Zellen und Spalten.... Microsoft Office Suite 20. Okt. 2015
onChange Inhalt einer Zelle in eine andere Zelle kopieren StarOffice, OpenOffice und LibreOffice 22. Mai 2014
Excel 2010 Wenn Zelle leer dann, Wenn in Zelle x dann Windows XP Forum 28. Nov. 2013
Zellen je nach Inhalt automatisch in richtige Spalte verschieben Microsoft Office Suite 15. Juli 2013