Schleife zum füllen einer Tabelle

Hallo,
habe eine sogenannte Lasttabelle die in zwei Spalten aufgeteilt ist, die bekomme ich so von unserem Energieanbieter. In der Spalte A steht das Datum mit Uhrzeit im Viertelstunden Rythmus und in der Spalte B der gemessene kw Wert zu dem Zeitpunkt.
Nun möchte ich aber die Werte in einer Kreutztabelle haben um die Werte mit Bedingter Formatierung in einer Gant Grafik darzustellen.
Wie ich das mit den Achsen mache weis ich aber ich hätte gerne eine Schleife oder den Ansatz dazu wie ich die Werte in den Spalten auslese und in der Tabelle eintrage.
Zum besseren Verständniss habe ich einen kleinen Ausschnitt der Lastgangtabelle angehängt.
https://www.herber.de/bbs/user/105385.xlsx
Ein Bericht (Tabellenblatt) ist ein Monat und hat ca. 3000 Zeilen.
Hoffe das ist verständlich :-)
p.s. bin VBA Anfänger und sehe die Aufgabe auch als Übung.
Grüße
Sam

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Sam,
anbei ein kurzer Makro Code als Lösungsvorschlag für diese Aufgabe.
Ich gehe davon aus das die Spalten und Zeilen wie im Beispiel stimmen.
Sonst müssten die Range Angaben im Makro manuell geaendert werden.
Würde mich freuen wenn die Aufgabe damit gelöst ist.
mfg Piet

Option Explicit      'Kreuztabelle erstellen
Const UhrZeit = "E4:K4"    'Uhrzeit Überschriftzeile
Sub Kreuztabelle_erstellen()
Dim DA As Object, AC As Object
Dim Datum As Date, Zeile As Long
Dim Zeit As Date, SZeit As Single
With Worksheets("Tabelle1 (2)")
'alte Tabelle löschen, 1.Zeile = 4
.Range("C5:K10000").ClearContents
Zeile = 5 - 1   '1.Zeile  (5-1)
'Schleife für Zeitstempel Werte
For Each DA In Range("A5", [a5].End(xlDown))
'Datum prüfen, naechstes Datum setzen
If CDate(Mid(DA, 1, 10))  Datum Then
Zeile = Zeile + 1  'Zeile +1
Datum = CDate(Mid(DA, 1, 10))
Cells(Zeile, 4) = Datum
End If
Zeit = CDate(Mid(DA, 13, 8))
SZeit = CSng(Zeit) 'als Zahl
'Schleife für Uhrzeit Überschrift
For Each AC In Range(UhrZeit)
If AC.Value = SZeit Then
Cells(Zeile, AC.Column) = DA.Offset(0, 1)
Zeit = Empty:  Exit For
End If
Next AC
'Fehlermeldung:  aktuelle Zeit "Not Find"
If Zeit  Empty Then DA.Offset(0, 2) = "Not Find"
Next DA
End With
End Sub

Option Explicit Public sp As Long Public ze1 As Long Public ze2 As Long Public zeile As Long Public ze As Range Sub put_step1() ze1 = 5: ze2 = 5 Range("D5:CV3000").ClearContents Cells(5, 4) = Cells(5, 1) Do While Cells(ze1, 1) "" If CDate(Left(Cells(ze2, 4), 10)) CDate(Left(Cells(ze1, 1), 10)) Then ze2 = ze2 + 1 End If Cells(ze2, 4) = CDate(Left(Cells(ze1, 1), 10)) ze1 = ze1 + 1 Loop put_step2 End Sub Sub put_step2() ze2 = 5: zeile = 5 For Each ze In Range("D5:D" & Cells(Rows.Count, 4).End(xlUp).Row) For sp = 5 To 100 Cells(ze2, sp) = Cells(zeile, 2).Value zeile = zeile + 1 Next ze2 = ze2 + 1 Next End Sub

Beliebteste Forumthreads (12 Monate)

Schleife zum füllen einer Tabelle

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Schleife zum füllen einer Tabelle

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread