Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1536to1540
1536to1540
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Tabellenblätter erstellen

Forumthread: Tabellenblätter erstellen

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?
Anzeige

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

Betreff
Datum
Anwender
Anzeige
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
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
Anzeige
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)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige