Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1236to1240
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
Inhaltsverzeichnis

2-dimensionales Array Sortieralgorithmus

2-dimensionales Array Sortieralgorithmus
Andi
Hallo,
zuvor habe ich Daten auf einem Excelsheet sortiert.
Jetzt soll aber das ganze auf ein Formular / Tabelle. Auf dem Formular habe ich das Steuerelement "Spreadsheet" von Microsoft eingefügt.
Wie bekomme ich meine Daten sortiert? Muß mehrere Felder sortieren, Nummer aufsteigend und Issue absteigend.
1) Die Daten weiterhin auf einer Tabelle (verry hidden) sortieren lassen und anschliessend das Ergebnis dem Array übergeben?
2) Das Array direkt über eine VBA Routine sortieren?
Wie sieht es aber mit einem 2-dimensionalen Array aus, das nach "mehreren" Spalten sortiert werden soll?
3) Zusätzliche Frage: Lässt das Steuerelement "Spreadsheet" Zeilengruppierungen zu?

Danke.
Gruß Andi

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
Erledigt
02.11.2011 17:09:28
Andi
Dankeschön an Nepumuk
http://www.online-excel.de/excel/singsel_vba.php?f=97
' **************************************************************
' Modul: Modul1 Typ = Allgemeines Modul
' **************************************************************
Option Explicit
' Code Max Kaffl 2005
Public Sub prcTest()
Dim intColumn As Integer
Dim lngRow As Long
Dim vntArray(1 To 10000, 1 To 30) As Variant
Dim vntSortArray As Variant
'die zu sortierenden Spalten
'negative Zahl = Spalte absteigend sortieren
'positive Zahl = Spalte aufsteigend sortieren
vntSortArray = Array(1, -2, 8, 3, -4, -5)
'TestArray füllen
Randomize Timer
For lngRow = 1 To 10000
For intColumn = 1 To 30
vntArray(lngRow, intColumn) = Fix((5 * Rnd) + 1)
Next
Next
'Sortierroutine starten
Call prcSort(vntSortArray, vntArray())
'Ausgabe Testarray
Application.ScreenUpdating = False
Range("A1:AD10000").Value = vntArray
Application.ScreenUpdating = True
End Sub

Private Sub prcSort(vntSortArray As Variant, vntArray() As Variant)
Dim intIndex As Integer
Dim lngIndex1 As Long, lngIndex2 As Long, lngRowsArray() As Long
Dim lngRowsCount As Long, lngRangeCount As Long
Dim vntTemp As Variant
ReDim lngRowsArray(0 To 1, 0 To UBound(vntArray) * 2)
'Array für den 1. Sortierlauf
lngRowsArray(0, 0) = LBound(vntArray)
lngRowsArray(0, 1) = UBound(vntArray)
lngRowsCount = 1
For intIndex = LBound(vntSortArray) To UBound(vntSortArray)
'Wenn eine Spalte angegeben
If vntSortArray(intIndex)  0 Then
lngRangeCount = -1
'Schleife zum sortieren der einzelnen Bereiche
For lngIndex1 = 0 To lngRowsCount Step 2
'Sortieren des Bereichs, wenn Zeilenzahl größer 1
If lngRowsArray(0, lngIndex1)  lngRowsArray(0, lngIndex1 + 1) Then
Call prcQuickSort(CLng(lngRowsArray(0, lngIndex1)), _
CLng(lngRowsArray(0, lngIndex1 + 1)), CInt(Abs(vntSortArray(intIndex))), _
_
CBool(vntSortArray(intIndex) > 0), vntArray())
'sortierten Bereich merken
lngRangeCount = lngRangeCount + 2
lngRowsArray(1, lngRangeCount - 1) = lngRowsArray(0, lngIndex1)
lngRowsArray(1, lngRangeCount) = lngRowsArray(0, lngIndex1 + 1)
End If
Next
lngRowsCount = -1
'Durchsuchen der soeben sortierten Spalte nach Wertewechsel
For lngIndex1 = 0 To lngRangeCount Step 2
'1. Zeile des zu sortierenden Bereichs
vntTemp = vntArray(lngRowsArray(1, lngIndex1), Abs(vntSortArray(intIndex)))
lngRowsCount = lngRowsCount + 1
lngRowsArray(0, lngRowsCount) = lngRowsArray(1, lngIndex1)
'Suche nach Wechsel innerhalb des Bereichs
For lngIndex2 = lngRowsArray(1, lngIndex1) To lngRowsArray(1, lngIndex1 + 1)
If vntTemp  vntArray(lngIndex2, Abs(vntSortArray(intIndex))) Then
lngRowsCount = lngRowsCount + 2
lngRowsArray(0, lngRowsCount - 1) = lngIndex2 - 1
lngRowsArray(0, lngRowsCount) = lngIndex2
vntTemp = vntArray(lngIndex2, Abs(vntSortArray(intIndex)))
End If
Next
'letzte Zeile des zu sortierenden Bereichs
lngRowsCount = lngRowsCount + 1
lngRowsArray(0, lngRowsCount) = lngRowsArray(1, lngIndex1 + 1)
Next
End If
Next
End Sub

Private Sub prcQuickSort(lngLbound As Long, lngUbound As Long, _
intSortColumn As Integer, bntSortKey As Boolean, vntArray() As Variant)
Dim intIndex As Integer
Dim lngIndex1 As Long, lngIndex2 As Long
Dim vntTemp As Variant, vntBuffer As Variant
lngIndex1 = lngLbound
lngIndex2 = lngUbound
vntBuffer = vntArray((lngLbound + lngUbound) \ 2, intSortColumn)
Do
If bntSortKey Then
Do While vntArray(lngIndex1, intSortColumn)  vntBuffer
lngIndex1 = lngIndex1 + 1
Loop
Do While vntBuffer > vntArray(lngIndex2, intSortColumn)
lngIndex2 = lngIndex2 - 1
Loop
End If
If lngIndex1  _
vntArray(lngIndex2, intSortColumn) Then
For intIndex = LBound(vntArray, 2) To UBound(vntArray, 2)
vntTemp = vntArray(lngIndex1, intIndex)
vntArray(lngIndex1, intIndex) = _
vntArray(lngIndex2, intIndex)
vntArray(lngIndex2, intIndex) = vntTemp
Next
End If
lngIndex1 = lngIndex1 + 1
lngIndex2 = lngIndex2 - 1
ElseIf lngIndex1 = lngIndex2 Then
lngIndex1 = lngIndex1 + 1
lngIndex2 = lngIndex2 - 1
End If
Loop Until lngIndex1 > lngIndex2
If lngLbound 

Anzeige

48 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige