Transponieren im großen Umfang

Hallo ich bin neu hier im Forum...
Habe folgendes Problem...
Ich habe ViertelStunden Werte von einem Jahr in einer Spalte mit entsprechendem Datum... Das sind Ökostromeinspeisemenegen, welche viertelstündlich sich verändern... Also gibt es eine Spalte mit 4(viertelstunden)x24(stunden)x365(Tage)=35040 zeilen.
Nun würde ich gerne die Tabelle Transponieren, so dass ich 96 (Viertelstudenwerte) Spalten habe und 365 (Tage) Zeilen... Per Hand wäre es eine aufwendige Arbeit
Also von
01.01.2007 00:00:00 0,01540
01.01.2007 00:15:00 0,01543
01.01.2007 00:30:00 0,01555
01.01.2007 00:45:00 0,01557
01.01.2007 01:00:00 0,01548
01.01.2007 01:15:00 0,01545
01.01.2007 01:30:00 0,0154
01.01.2007 01:45:00 0,01528
01.01.2007 02:00:00 0,01547
01.01.2007 02:15:00 0,01539
01.01.2007 02:30:00 0,01542
01.01.2007 02:45:00 0,01533
01.01.2007 03:00:00 0,01549
01.01.2007 03:15:00 0,01545
01.01.2007 03:30:00 0,01545
01.01.2007 03:45:00 0,01544
01.01.2007 04:00:00 0,01553
01.01.2007 04:15:00 0,0153
Transponiert in
00:00:00 00:15:00 00:30:00 00:45:00 01:00:00 01:15:00
01.01.2007 0,06755 0,06653 0,06554 0,06476 0,06549 0,0658

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Thomas,
probier mal. (Tabellennamen anpassen)
' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub transponieren()
Dim objWS As Worksheet, objTarget As Worksheet
Dim lngStart As Long, lngEnd As Long, lngC As Long, lngI As Long
Dim intC As Integer
Dim vTmp As Variant

On Error GoTo ErrExit
GMS

Set objWS = Sheets("Tabelle1") 'Tabelle mit den daten - anpassen!
Set objTarget = ThisWorkbook.Worksheets.Add(after:=objWS)

lngStart = 2 'erste Zeile mit daten - anpassen!
lngEnd = Application.Max(lngStart, objWS.Cells(Rows.Count, 1).End(xlUp).Row)
lngI = 2

With objTarget
    .Name = "Liste vom_" & Format(Now, "yyyymmdd-hhmmss")
    .Cells(1, 1) = "Datum"
    For intC = 1 To 96
        .Cells(1, intC + 1) = Format(TimeSerial(0, (intC - 1) * 15, 0), "hh:mm")
    Next
    .Rows(1).Font.Bold = True


    For lngC = lngStart To lngEnd Step 96
        vTmp = objWS.Range(objWS.Cells(lngC, 1), objWS.Cells(lngC + 95, 3))
        .Cells(lngI, 1) = vTmp(1, 1)
        For intC = 1 To 96
            .Cells(lngI, intC + 1) = vTmp(intC, 3)
        Next
        lngI = lngI + 1
    Next
    .Columns.AutoFit
End With

ErrExit:
GMS True
Set objWS = Nothing
Set objTarget = Nothing
End Sub

Sub GMS(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long

With Application
    .ScreenUpdating = Modus
    .EnableEvents = Modus
    .DisplayAlerts = Modus
    .EnableCancelKey = IIf(Modus, 1, 0)
    If Modus Then
        .Calculation = lngCalc
    Else
        lngCalc = .Calculation
        .Calculation = xlCalculationManual
    End If
    .Cursor = IIf(Modus, -4143, 2)
    .CutCopyMode = False
End With

End Sub

Gruß Sepp

Sub Umsetzen_Werte96() '+++++++ANPASSEN+++++++ sQuelle = "Tabelle1" 'hier stehen die viertelstunden-werte sZiel = "Tabelle2" 'neue Tabelle lZeile = Sheets(sQuelle).Cells(65536, 1).End(xlUp).Row '+++++umsetzen nZeile = 1 For z = 1 To lZeile Step 96 'Datum Sheets(sZiel).Cells(nZeile, 1) = Sheets(sQuelle).Cells(z, 1) ' 24h-Werte For i = 1 To 96 Sheets(sZiel).Cells(nZeile, i + 1) = Sheets(sQuelle).Cells(z + i, 3) Next i nZeile = nZeile + 1 Next z End Sub

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread