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
1524to1528
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

KW bei klick +1 zählen

KW bei klick +1 zählen
24.11.2016 09:45:37
Gabi
Hallo zusammen,
Folgendes:
Ich habe eine Planung mit einer Excel Datei erstellt. Dabei ist jedes Tabellen nach seiner KW benannt. Nun möchte ich, dass per Knopfdruck ein neues Tabellenblatt erstellt wird und dabei immer die letzte KW +1 als Tabellenblattname hinterlegt ist. Ist das Ganze bei der Letzten KW im Jahr angekommen, soll es auf KW 1 im neuen Jahr springen.
Zudem ist das Datum der kompletten Woche in der jeweiligen KW-Tabelle eingetragen. Gibt es eine Möglichkeit, das ebenfalls gleichzeitig an die neue KW anpassen zu lassen?
Mein aktuelle Code lautet:
Sub DienstplanNeueKW() 'neue KW per Knopfdruck
Dim wksSheetZ As Worksheet
Dim strFile As String
Dim lngCalc As Long
Dim lngTMP As Long
On Error GoTo Fin
strFile = ThisWorkbook.Path & Application.PathSeparator & "Vorlage.xltx"
With Application
.ScreenUpdating = False
.AskToUpdateLinks = False
.EnableEvents = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
ThisWorkbook.Worksheets("Vorlage").Visible = xlSheetVisible
With Tabelle4
ThisWorkbook.Worksheets("Vorlage").Copy After:=ThisWorkbook.Worksheets( _
Worksheets.Count)
ThisWorkbook.Worksheets(Worksheets.Count).Name = "KW " & 39 + 1
Set wksSheetZ = Nothing
End With
Fin:
ThisWorkbook.Worksheets("Vorlage").Visible = xlSheetHidden
Set wksSheetZ = Nothing
With Application
.ScreenUpdating = True
.AskToUpdateLinks = True
.EnableEvents = True
.Calculation = lngCalc
.DisplayAlerts = True
End With
If Err.Number  0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End If
End Sub
Mit meinem Code kann ich zwar manuell die letzte KW eingeben und dann +1 Zählen lassen aber das bringt mir leider nichts...
Anbei die Datei: https://www.herber.de/bbs/user/109679.xlsm
Vielen Dank vorab.
Liebe Grüße
Gabi

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
OT: Ist ein Blatt pro Woche nötig?
24.11.2016 14:51:08
lupo1
Normalerweise ist das nie der Fall.
Am besten hast Du alle Daten in einem Blatt und wertest sie in einem anderen aus.
AW: OT: Ist ein Blatt pro Woche nötig?
24.11.2016 20:49:19
Gabi
Hallo,
und es gibt keine Möglichkeit, dass VBA mit den KW´s rechnen kann und immer +1 zählt?
Liebe Grüße
Gabi
kein Problem, aber
26.11.2016 16:16:06
Michael
Hi Gabi,
grundsätzlich schließe ich mich lupos Argumentation an: es ist doch grätzig, dauernd zwischen irgendwelchen Blättern hin und her zu springen.
Ein logischer Knackpunkt ergibt sich aber insofern, als soll es auf KW 1 im neuen Jahr springen dazu führt, daß im nächsten Jahr der Blattname "KW 1" sich wiederholen würde - was natürlich nicht geht.
D.h., man müßte noch das Jahr mitschleppen: "KW_16 1" usw., wodurch *noch* weniger Blätter gleichzeitig sichtbar bzw. wählbar wären.
Ist das erwünscht?
Ansonsten schau mal: https://www.herber.de/bbs/user/109742.xlsm
Schöne Grüße,
Michael
Anzeige
AW: kein Problem, aber
26.11.2016 21:02:51
Gabi
Hallo Michael,
danke für deine Antwort. Nein es ist dann natürlich so gedacht, dass die älteren KW´s nach und nach herausgelöscht und archiviert werden. Somit sind diese nicht doppelt hinterlegt. Ich schaue mal wie ich es hinbekomme.
LG Gabi
AW: kein Problem, aber
27.11.2016 14:58:10
Michael
Hi Gabi,
ich hab Dir schnell einen "Ansatz" eingebaut:
Sub neueKW()
Dim hKW&, aktWS ' & = as long, "höchste KW", "aktuelles Worksheet"
Dim d As Date
Dim sh As Worksheet, alleSh As String
alleSh = "!" ' ! dürfen in Blattnamen nicht vorkommen,
' deshalb eignet es sich ganz gut als Trennzeichen
For Each sh In ThisWorkbook.Worksheets
alleSh = alleSh & sh.Name & "!"
Next
hKW = Split(Sheets(Sheets.Count).Name, " ")(1) * 1
If InStr(alleSh, "!KW " & hKW + 1 & "!") > 0 Then
MsgBox "Die neue anzulegende KW ist bereits vorhanden!" & vbLf _
& "Bitte archivieren Sie zuerst "
Exit Sub
End If
d = Sheets(Sheets.Count).Range("D1")
aktWS = ActiveSheet.Index
' hier bei Bedarf alles mögliche ausschalten
Sheets("Vorlage").Copy after:=Sheets(Sheets.Count)
' wird kopiert, ob visible oder nicht
ActiveSheet.Name = "KW " & hKW + 1
ActiveSheet.Range("D1") = d + 7
Sheets(aktWS).Activate
End Sub

Falls ein bereits vorhandenes Blatt angelegt werden soll, kommt die msgbox und der Rest wird nicht ausgeführt. Anstelle der msgbox könntest Du natürlich die betreffenden Blätter direkt "wegschreiben".
Andererseits: so ist es für den Anwender vielleicht transparenter: Du hast ja vielleicht schon ein Makro für die Archivierung, den er nur anklicken muß.
Übrigens habe ich mich für die "faule" Lösung mit dem "Datum im neuen Blatt" entschieden, derweil ein Makro ohne Jahresangabe aus einer KW auch kein Datum errechnen kann: das sind die Anweisungen mit Range("D1"), wo Du nur D1 durch die Zelle ersetzen mußt, die das Datum tatsächlich enthält:
d = Sheets(Sheets.Count).Range("D1")
' .... und unten:
ActiveSheet.Range("D1") = d + 7
Happy exceling,
Michael
Anzeige
AW: kein Problem, aber
01.12.2016 23:01:42
Gabi
Hallo Michael,
oh du bist ein Schatz! vielen Dank, danach habe ich gesucht. Ich werde es direkt die nächsten Tage einmal ausprobieren.
LG Gabi

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige