Thema Datum  Von Nutzer Rating
Antwort
29.09.2015 10:49:00 Matthias
NotSolved
Blau Excel Tabelle sortieren/transponieren
29.09.2015 23:10:24 BigBen
NotSolved

Ansicht des Beitrags:
Von:
BigBen
Datum:
29.09.2015 23:10:24
Views:
624
Rating: Antwort:
  Ja
Thema:
Excel Tabelle sortieren/transponieren

Hallo,

mit dem nachstehenden Code werden die alle Daten, die mit dem Namen "Daten" benannt worden sind, sortiert und in der Tabelle2, Spalte 1 in aufsteigender Reihenfolge eingetragen:

Sub SortData()
    Dim rng As Range, cl As Range
    Dim data() As Double
    Dim iCnt As Integer
    
    Set rng = ActiveWorkbook.Names("Daten").RefersToRange
    iCnt = -1
    For Each cl In rng.Cells
        iCnt = iCnt + 1
        ReDim Preserve data(iCnt)
        data(iCnt) = Val(cl.Formula)
    Next
    
    ' Sort Data
    
    QuickSort data, 0, UBound(data)
    
    ' Eintragen in Spalte A der Tabelle 2
    InsertData data, 1
End Sub

Sub InsertData(ByRef arData As Variant, iColumn As Integer)
    Dim sh As Worksheet
    Dim vItem As Variant
    Dim iRw As Integer
    Set sh = ActiveWorkbook.Worksheets("Tabelle2")
    For Each vItem In arData
        iRw = iRw + 1
        sh.Cells(iRw, iColumn).FormulaR1C1 = vItem
    Next
    
End Sub


' Quelle: https://msdn.microsoft.com/de-de/library/bb979305.aspx
Private Sub QuickSort( _
                      ByRef ArrayToSort As Variant, _
                      ByVal Low As Long, _
                      ByVal High As Long)
Dim vPartition As Variant, vTemp As Variant
Dim i As Long, j As Long
  If Low > High Then Exit Sub  ' Rekursions-Abbruchbedingung
  ' Ermittlung des Mittenelements zur Aufteilung in zwei Teilfelder:
  vPartition = ArrayToSort((Low + High) \ 2)
  ' Indizes i und j initial auf die äußeren Grenzen des Feldes setzen:
  i = Low: j = High
  Do
    ' Von links nach rechts das linke Teilfeld durchsuchen:
    Do While ArrayToSort(i) < vPartition
      i = i + 1
    Loop
    ' Von rechts nach links das rechte Teilfeld durchsuchen:
    Do While ArrayToSort(j) > vPartition
      j = j - 1
    Loop
    If i <= j Then
      ' Die beiden gefundenen, falsch einsortierten Elemente
austauschen:
      vTemp = ArrayToSort(j)
      ArrayToSort(j) = ArrayToSort(i)
      ArrayToSort(i) = vTemp
      i = i + 1
      j = j - 1
    End If
  Loop Until i > j  ' Überschneidung der Indizes
  ' Rekursive Sortierung der ausgewählten Teilfelder. Um die
  ' Rekursionstiefe zu optimieren, wird (sofern die Teilfelder
  ' nicht identisch groß sind) zuerst das kleinere
  ' Teilfeld rekursiv sortiert.
  If (j - Low) < (High - i) Then
    QuickSort ArrayToSort, Low, j
    QuickSort ArrayToSort, i, High
  Else
    QuickSort ArrayToSort, i, High
    QuickSort ArrayToSort, Low, j
  End If
End Sub

VG, BigBen


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
29.09.2015 10:49:00 Matthias
NotSolved
Blau Excel Tabelle sortieren/transponieren
29.09.2015 23:10:24 BigBen
NotSolved