Tabellenblätter erstellen

Forumthread: Tabellenblätter erstellen

04.02.2017 15:36:05

Manuel

Hallo liebes Forum,
Ich habe eine Frage bezüglich einer Excel-Aufgabe, wo ich nicht weiterkomme.
Und zwar soll ich eine Tabelle für jeden Monat eines Jahres erzeugen, welche in das entsprechende Tabellenblatt eingetragen wird. Ich habe das für die ersten beiden Monate mal mit einer Aufzeichnung als Makro gemacht und hier ist die Datei zu finden:
https://drive.google.com/open?id=0Bywnp5Bpgp_gZ1FjWUVxYnBJeVk
Meine Frage nun: Wie kann ich das eleganter mit VBA lösen? Also die KW-Wochen sollten für jeden Monat fortlaufend gezählt werden. Und wenn man auf den Button klickt, sollte ein Fenster erscheinen, wo man auch das Jahr auswählen kann. Drei Jahre sollten es mindestens sein.
Kann mir jemand helfen?

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

kannst Du die Datei hier hochladen ...

04.02.2017 16:11:00

Tino
AW: kannst Du die Datei hier hochladen ...

04.02.2017 16:16:26

Manuel
kannst mal testen

04.02.2017 18:14:23

Tino
AW: kannst mal testen

04.02.2017 18:32:23

Manuel
Thread erledigt - geschlossen oWt

05.02.2017 00:40:01

Piet

kannst Du die Datei hier hochladen ...

04.02.2017 16:11:00

Tino

Hallo,
mach den Upload über die hier zur Verfügung gestellten "Zum File-Upload" Funktion.
Gruß Tino

AW: kannst Du die Datei hier hochladen ...

04.02.2017 16:16:26

Manuel

Hallo ,
hab es hochgeladen:
https://www.herber.de/bbs/user/111185.xlsm

kannst mal testen

04.02.2017 18:14:23

Tino

Hallo,
kannst mal diesen Code testen!
Modul Modul1

Option Explicit 
 
Sub Maschinenbenutzung() 
Dim varJahr 
Dim n&, i&, ii&, nKW& 
Dim strTabName$ 
Dim Datum As Date 
Dim oWS As Worksheet, oRefTabelle As Worksheet 
 
Const AnzahlJahr& = 3 'Anzahl Jahre 
Set oRefTabelle = Tabelle1 'Referenztabelle 
 
 
varJahr = Application.InputBox("Geben sie das Jahr ein", "Jahr", Year(Date), Type:=1) 
If VarType(varJahr) = vbBoolean Then Exit Sub 
 
On Error GoTo ErrorHandler: 
Call Events(False) 
 
For n = 1 To 12 * AnzahlJahr 
    Datum = DateSerial(varJahr, n, 1) 
    strTabName = Format(DateSerial(varJahr, n, 1), "mmmm yyyy") 
     
    If Not CheckTabelle(strTabName) Then 
        oRefTabelle.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 
        Set oWS = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 
        oWS.Name = strTabName 
        ii = 9 
 
        Do While Month(Datum) = Month(DateSerial(varJahr, n, 1)) 
            oWS.Cells(2, ii).Value = "KW" & KW(Datum) 
            Datum = Datum + 7 
            ii = ii + 1 
        Loop 
         
        For ii = ii To 13 
            oWS.Cells(2, ii).Value = "" 
        Next ii 
        Call LoescheButton(oWS) 
    End If 
Next n 
 
ErrorHandler: 
Application.Goto oRefTabelle.Cells(1, 1) 
Call Events(True) 
 
If Err.Number <> 0 Then 
    MsgBox Err.Description, vbCritical, "Fehler: " & Err.Number 
End If 
End Sub 
 
Function CheckTabelle(strTabName$) As Boolean 
On Error Resume Next 
CheckTabelle = ThisWorkbook.Sheets(strTabName).Index <> 0 
Err.Clear 
Err.Number = 0 
On Error GoTo 0 
End Function 
 
Private Function KW(d As Date) As Integer 
Dim t As Variant 
    t = DateSerial(Year(d + (8 - Weekday(d)) Mod 7 - 3), 1, 1) 
    KW = (d - t - 3 + (Weekday(t) + 1) Mod 7) \ 7 + 1 
End Function 
 
Private Sub LoescheButton(oWS As Worksheet) 
On Error Resume Next 
oWS.DrawingObjects.Delete 
Err.Clear 
Err.Number = 0 
On Error GoTo 0 
End Sub 
 
Private Sub Events(booSchalter As Boolean) 
With Application 
    .ScreenUpdating = booSchalter 
    .DisplayAlerts = booSchalter 
    .EnableEvents = booSchalter 
    .Calculation = IIf(booSchalter, xlCalculationAutomatic, xlCalculationManual) 
End With 
End Sub

Gruß Tino

AW: kannst mal testen

04.02.2017 18:32:23

Manuel

Funktioniert wunderbar!
Danke dir ;)

Thread erledigt - geschlossen oWt

05.02.2017 00:40:01

Piet

...

Beliebteste Forumthreads (12 Monate)

Forumthread: Tabellenblätter erstellen

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread