Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
980to984
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
980to984
980to984
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Autom. Tabellen erzeugen

Autom. Tabellen erzeugen
27.05.2008 22:54:30
M
Hallo Excel- und VBA Profis,
ich habe mich konzeptionell mal wieder vor für mich unlösbare Aufgaben gestellt - aber diese Exceltabelle ist bald fertig und ich habe dabei ne menge gelernt, was das nachfragen beim nächsten mal reduziert.
Nun möchte ich zu meinem Anliegen kommen. Ich möchte durch einen Button-click in einem gesonderten Tabellenblatt eine Tabelle erzeugen. Ich habe hierfür ein Eingabefeld mit dem die Anzahl der spalten gesteuert werden soll. Im Weiteren habe ich ein Eingabefeld für ein Startzeitpunkt im Format dd.mm.jjjj hh:mm, ein Eingabefeld für einen Endzeitpunkt im gleichen Format und ein Eingabefeld für die Zeitintervallbreite.
Wird jetzt also als Startzeitpunkt festgelegt: 20.05.2009 17:00 und als
Endzeitpunkt: 21.05.2009 17:00. Die Zeitintervallbreite beträgt 60 min.
Damit soll in einem gesonderten Tabellen Blatt eine Tabelle mit definierten Formatieren (Hintergrund Schriftgröße, usw) und der entsprechenden Anzahl von spalten erzeugt werden.
Brennstoff 1 Brennstoff 2 Brennstoff 3
20.05.2009 17:00
20.05.2009 18:00
20.05.2009 19:00
.
.
.
21.05.2009 17:00
Wie könnte hierfür einfach ein Makro aussehen?
Ich würde mich über Hinweise sehr freuen.
Danke und Viele Grüße
Marc

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Autom. Tabellen erzeugen
27.05.2008 23:19:00
Josef
Hallo Marc,
als Ansatz.
Sub Tabelle_anlegen()
Dim objWS As Worksheet
Dim datStart As Date, datEnd As Date, datAdd As Date, intCnt As Integer, dblIntervall As Double
Dim lngRow As Long, lngCol As Long, lngColCnt As Long


Set objWS = Sheets("Tabelle2") 'Tabelle in de die "Tabelle" angelegt wird

With Sheets("Tabelle1") 'Tabelle mit den Startdaten
    lngColCnt = .Range("B1") 'Anzahl der Spalten
    datStart = .Range("B2") 'Startzeitpunkt
    datEnd = .Range("B3") 'Endzeitpunkt
    dblIntervall = .Range("B4") / 1440 'Interval in Minuten
End With

With objWS
    
    .Cells.ClearContents
    
    .Cells(1, 1) = "Datum"
    
    For lngCol = 2 To lngColCnt + 1
        .Cells(1, lngCol) = "Brennstoff " & CStr(lngCol - 1)
    Next
    
    lngRow = 2
    
    For datAdd = datStart To datEnd + dblIntervall Step dblIntervall
        .Cells(lngRow, 1) = datAdd
        lngRow = lngRow + 1
    Next
    
    .Columns.AutoFit
    .Rows(1).Font.Bold = True
    
End With
End Sub



Gruß Sepp



Anzeige
AW: Autom. Tabellen erzeugen
28.05.2008 11:55:00
M
Hallo Sepp,
ich habe versucht den Code entsprechend anzupassen, komme damit jedoch nicht so richtig klar.
Ich habe folgende Tabelle:
Userbild
und ich möchte entsprechend der Datumseingaben und Zeitintervallbreite, das die Zeilen, in denen das Datum und die Uhrzeit steht, entsprechend kopiert bzw. gelöscht werden. ich möchte allerdings, dass vorhandene evtl. Zellbezüge zu anderen Tabellen mit übernommen werden.
Wie kann ich das anpassen? Würde mich über einen Hinweis sehr freuen.
Danke und Gruß,
Marc

Anzeige
AW: Autom. Tabellen erzeugen
29.05.2008 21:46:00
Josef
Hallo Marc,
deine Frage ging aber in eine andere Richtung.
Lade eine Beispieltabelle hoch, mit einem Bild kann ich nichts anfangen.

Gruß Sepp



AW: Autom. Tabellen erzeugen
30.05.2008 08:53:00
M
Hallo Sepp,
hier habe ich einmal den Code, mit dem ich das versuche umzusetzen. Ich versuche dies im Tabellenblatt Terminkontrakte zu erzeugen. Für das Tabellenblatt "brennstoffe" funktioniert das, aber für das Tabellenblatt "Terminkontakte" - keine Chance.

Private Function MakeTimeTable(ws As Worksheet, times) As Integer
Dim z As Integer
Dim zahl As Integer
Dim i As Integer
On Error Resume Next
If ws Is Nothing Then
MakeTimeTable = ERR_MISSINGWORKSHEET
Exit Function
End If
zahl = UBound(times)
If ws.name = "Brennstoffe" Then
z = 11
Else
z = 3
Do
If ws.Cells(z, 1) = "Zeit" Then Exit Do
z = z + 1
Loop While z = MAXZ Then
MakeTimeTable = ERR_CANNOTFINDTIMEROW
Exit Function
End If
If Trim(ws.Cells(z + 1, i)) = "" Then z = z + 1
If UCase(Left(ws.Cells(z + 1, 1), 2)) = "PI" Then
z = z + 1
ElseIf UCase(Left(ws.Cells(z + 2, 1), 2)) = "PI" Then
z = z + 2
ElseIf ws.name = "Start" And UCase(Left(ws.Cells(z + 3, 1), 2)) = "PI" Then
z = z + 3
End If
End If
i = 0
Do
z = z + 1
If Trim(ws.Cells(z, 1)) = "" Then
ws.Rows(z - 1).Copy
ws.Rows(z).Insert shift:=xlDown
End If
ws.Cells(z, 1) = Format(times(i), "dd.MM.yyyy HH:mm")
ws.Cells(z, 1).HorizontalAlignment = xlCenter
i = i + 1
Loop While i  ""
ws.Rows(z).Delete
Loop
MakeTimeTable = 0
ws.Cells(1, 1).Select
If ws Is Nothing Then
MakeTimeTable = ERR_MISSINGWORKSHEET
Exit Function
End If
If ws.name = "Terminkontrakte" Then
z = 11
Else
z = 3
Do
If ws.Cells(z, 1) = "Zeit" Then Exit Do
z = z + 1
Loop While z = MAXZ Then
MakeTimeTable = ERR_CANNOTFINDTIMEROW
Exit Function
End If
If Trim(ws.Cells(z + 1, i)) = "" Then z = z + 1
If UCase(Left(ws.Cells(z + 1, 1), 2)) = "PI" Then
z = z + 1
ElseIf UCase(Left(ws.Cells(z + 2, 1), 2)) = "PI" Then
z = z + 2
ElseIf ws.name = "Start" And UCase(Left(ws.Cells(z + 3, 1), 2)) = "PI" Then
z = z + 3
End If
End If
i = 0
Do
z = z + 1
If Trim(ws.Cells(z, 1)) = "" Then
ws.Rows(z - 1).Copy
ws.Rows(z).Insert shift:=xlDown
End If
ws.Cells(z, 1) = Format(times(i), "dd.MM.yyyy HH:mm")
ws.Cells(z, 1).HorizontalAlignment = xlCenter
i = i + 1
Loop While i  ""
ws.Rows(z).Delete
Loop
MakeTimeTable = 0
ws.Cells(1, 1).Select
If ws Is Nothing Then
MakeTimeTable = ERR_MISSINGWORKSHEET
Exit Function
End If
End Function


Würde mich über Hinweise wo der Fehler liegt sehr freuen.
Beste Grüße,
Marc

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige