Office: Kalenderwoche durch datum des freitags dieser Kalenderwoche ersetzen

Hallo,

Ich muss in einer Tabelle , wenn in Spalte T
eine Kalenderwoche steht ( zB: "KW 42"),
diese durch das Datum des Freitags in selbiger Kalenderwoche ersetzen.
Wenn bereits ein datum eingegeben ist, darf nichts damit passieren.

Besten Dank

 

Hallo,

da du verlangst, dass der Wert der Zelle, die zB. "KW 42" enthält, ersetzt werden soll, durch das Datum des Freitags dieser KW, so ist dies nur mehr durch ein VBA-Makro möglich. Würde man dafür eine Arbeitsblattfunktion einsetzen, würde sofort ein Zirkelbezug entstehen.

Nachfolgend das Makro "SpalteT_KW_Datum". Es überprüft im aktiven Arbeitsblatt im benutzten Bereich die Spalte T, ob Zellen enthalten sind, deren Inhalt mit "KW " beginnt und dann eine Zahl im Bereich 1..53 folgt. Für solche Zellen erfolgt eine Umwandlung in ein gültiges Datum und zwar für den Freitag dieser KW.

Die Umwandlung ist für KWs im Datumsbereich 1.3.1900 - 31.12.9999 gültig (Europäische Kalenderwochen-Zählung).

Das Makro benötigt außerdem die Angabe, wo im aktiven Arbeitsblatt das Kalenderjahr zu finden ist für diese KW. Momentan ist dafür die Zelle A2 vorgesehen. Falls du diese Kalenderjahreszahl wo anders deponiert hast, musst du das im Makro ändern. Die Stelle habe ich dir genau gekennzeichnet.

Code:

Option Explicit

Sub SpalteT_KW_Datum()
   Dim Ws As Worksheet
   Dim rngSpalteT As Range, rngZelle As Range
   Dim strKW As String, intKW As Integer
   Dim Jan2KW As Double, Jahr As Integer
 
   Set Ws = ActiveSheet
   Set rngSpalteT = Intersect(Ws.Columns("T:T"), Ws.UsedRange)
 
   Jahr = Ws.Range("A2").Value                          '<--- Zelle mit Kalenderjahr im aktiven Arbeitsblatt
   Jan2KW = DateSerial(Jahr, 1, 2) / 7#
 
   For Each rngZelle In rngSpalteT.Cells
      With rngZelle
         If .Value Like "KW *" Then
            strKW = Mid$(.Value, 4)
            If IsNumeric(strKW) Then
               intKW = strKW
               If intKW > 0 And intKW <= 53 Then
                  .Value = 7 * Int(Jan2KW + strKW) - 1
                  .NumberFormat = "DD.MM.YYYY"          '<--- Datumsformat
               End If
            End If
         End If
      End With 'rngZelle
   Next rngZelle
 
End Sub

Das vorgenannte Makro musst du kopieren und in einem allgemeinen VBA-Codemodul einfügen.

Das Makro kann mit der Tastenkombination Alt+F8 ausgewählt und anschließend ausgeführt werden.
In der beiliegenden Datei ist außerdem der Button "KW ersetzen in Spalte T" im Arbeitsblatt "Tabelle1" enthalten, welcher mit dem Makro verknüpft ist. Durch Klick darauf wird das Makro ebenfalls ausgeführt.

 

Wow das hilft mir enorm weiter.
Eine weitere Frage dazu. ist es möglich das sowohl KW 20 und KW20 (ohne leerzeichen) damit "umgewandelt" werden?

Danke!

 

Hallo,

Code:

Option Explicit

Sub SpalteT_KW_Datum()
   Dim Ws As Worksheet
   Dim rngSpalteT As Range, rngZelle As Range
   Dim strKW As String, intKW As Integer
   Dim Jan2KW As Double, Jahr As Integer
   
   Set Ws = ActiveSheet
   Set rngSpalteT = Intersect(Ws.Columns("T:T"), Ws.UsedRange)
   
   Jahr = Ws.Range("A2").Value                          '<--- Zelle mit Kalenderjahr
   Jan2KW = DateSerial(Jahr, 1, 2) / 7#
   
   For Each rngZelle In rngSpalteT.Cells
      With rngZelle
         If .Value Like "KW*" Then                             '<---- Leerzeichen entfernt !!
            strKW = Mid$(.Value, 3)                            '<---- 4 --> 3 geändert !!
            If IsNumeric(strKW) Then
               intKW = strKW
               If intKW > 0 And intKW <= 53 Then
                  .Value = 7 * Int(Jan2KW + strKW) - 1
                  .NumberFormat = "DD.MM.YYYY"          '<--- Datumsformat
               End If
            End If
         End If
      End With 'rngZelle
   Next rngZelle
   
End Sub