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

Sortieren

Sortieren
07.02.2007 08:53:17
Stefan
Hallo zusammen,
ich möchte die folgende Tabelle nach Spalte A und anschließend B sortieren.
Wie könnte man das machen? Über die Sortierfunktion geht das ja leider nicht, da Spalte A-C ja einander zugeordnet bleiben sollen.
https://www.herber.de/bbs/user/40205.xls
Wenn es hilft kann ich die Zellen in Spalte A und B auch verbinden, sodaß keine Leerzeilen dort entstehen.
Vielleicht habt Ihr ja eine Idee.
Danke + Gruß,
Stefan

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Sortieren
Rudi
Hallo,
die Tabelle musst du schon durchgängig füllen. Für die Darstellung wie im Beispiel kannst du ja eine Pivot-Tabelle daraus erstellen.
Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe
AW: Sortieren
Stefan
Wozu brauch ich dann eine Pivot-Tabelle? Was ist das? Wie mach ich das?
Wenn ich alle Zellen füllen muss, kann ich ja auch über die Sortierfunktion ordnen. Nur dann geht mir die Übersicht verlohren, da ich ca. 700 Prüfer und ca. 500 Versuche. Ergebnisse dürften das dann ca. 20.000 sein, daher möchte ich nicht jede Zelle füllen.
Höchsten Zellen verbinden wie hier, aber dann gibts bei der Sortierfunktion mit der unterschiedlichen Zellengröße!
https://www.herber.de/bbs/user/40208.xls

Das Ergebniss sollte so aussehen:
https://www.herber.de/bbs/user/40209.xls

Hallo,
da sehe ich nur eine Möglichkeit:
1. Bereich in ein Array einlesen
2. Die Lücken im Array auffüllen
3. Array sortieren. (Qicksort für mehrere Spalten findest du bei Online-Excel)
4. Lücken im Array wieder herstellen
5. Array in dein Blatt zurückschreiben
Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe

Und wie mach ich das?
Habe noch nie (bewußt) mit Arrays gearbeitet.
Die Lücken könnte ich mittels Marko wahrscheinlich füllen, aber das war´s dann auch was meine Kenntnisse hergeben.
Gruß,
Stefan

Hallo,
in ein Modul:
Option Explicit
Sub Sortierung()
Dim i As Long, vntArray() As Variant, vntSortArray As Variant, rngTemp As Range
Dim strTemp1 As String, strTemp2 As String
With Sheets(1)
Set rngTemp = .Range(.Cells(2, 1), .Cells(Rows.Count, 3).End(xlUp))
vntArray = rngTemp
End With
For i = 1 To UBound(vntArray, 1)
If vntArray(i, 1) = "" Then vntArray(i, 1) = vntArray(i - 1, 1)
If vntArray(i, 2) = "" Then vntArray(i, 2) = vntArray(i - 1, 2)
Next i
vntSortArray = Array(1, 2, 3)
Call prcSort(vntSortArray, vntArray)
strTemp1 = vntArray(1, 1)
strTemp2 = vntArray(1, 2)
For i = 2 To UBound(vntArray, 1)
If vntArray(i, 1) = strTemp1 Then
vntArray(i, 1) = ""
Else
strTemp1 = vntArray(i, 1)
End If
If vntArray(i, 2) = strTemp2 Then
vntArray(i, 2) = ""
Else
strTemp2 = vntArray(i, 2)
End If
Next i
With Sheets(1)
.Range(.Cells(2, 1), .Cells(UBound(vntArray, 1) + 1, 3)) = vntArray
End With
Set rngTemp = Nothing
End Sub
Private Sub prcSort(vntSortArray As Variant, vntArray() As Variant)
'Code: Max Kaffl
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)
Dim i As Integer
'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)
'Code: Max Kaffl
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
Else
Do While vntArray(lngIndex1, intSortColumn) > vntBuffer
lngIndex1 = lngIndex1 + 1
Loop
Do While vntBuffer > vntArray(lngIndex2, intSortColumn)
lngIndex2 = lngIndex2 - 1
Loop
End If
If lngIndex1 < lngIndex2 Then
If vntArray(lngIndex1, intSortColumn) <> _
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 < lngIndex2 Then Call prcQuickSort(lngLbound, _
lngIndex2, intSortColumn, bntSortKey, vntArray())
If lngIndex1 < lngUbound Then Call prcQuickSort(lngIndex1, _
lngUbound, intSortColumn, bntSortKey, vntArray())
End Sub

Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe

Vielen Dank!
Das passt soweit alles super, nur eine Frage:
Kann man die Werte in Spalte A alle beibhalten? Ich möchte auch doppelte Test-Nr. beibehalten.
Ich habe mal links aufgelistet wie es das Makro ausgibt,Mitte wie ich es mir vorstelle.
Kann man mittels Makro auch noch die Zellen verbinden (rechts)?
https://www.herber.de/bbs/user/40218.xls
Danke + Gruß,
Stefan

Hallo,
ja, kann man.
Denk mal drüber nach unter welchen Bedingungen wann was auf "" gesetzt wird. Mit VBA gut wird dir das schon gelingen.
Gruß
Rudi
Eine Kuh mach muh, viele Kühe machen Mühe.

Moin,
VBA gut ist eine Definitionssache. Vielleicht ist das auch ein wenig hoch gegriffen...
Ich hab leider mit Array noch gar keine Erfahrungen und versteh so gut wie nichts in Deinem Script.
Gruß,
Stefan

Hallo,
bitte austauschen:

Sub Sortierung()
Dim vntArray() As Variant, vntSortArray As Variant, rngTemp As Range
Dim strTemp1 As String, strTemp2 As String
Dim lngLast As Long, lngRow As Long, lngFirst As Long
Application.ScreenUpdating = False
With Sheets(1)
Set rngTemp = .Range(.Cells(2, 1), .Cells(Rows.Count, 3).End(xlUp))
vntArray = rngTemp
End With
'Array komplett auffüllen
For lngRow = 1 To UBound(vntArray, 1)
If vntArray(lngRow, 1) = "" Then vntArray(lngRow, 1) = vntArray(lngRow - 1, 1)
If vntArray(lngRow, 2) = "" Then vntArray(lngRow, 2) = vntArray(lngRow - 1, 2)
Next lngRow
vntSortArray = Array(1, 2, 3) 'Sortierreihenfolge
Call prcSort(vntSortArray, vntArray)   'Array sortieren
'Überflüssige TestNr und Prüfer rauswerfen
strTemp1 = vntArray(1, 1)
strTemp2 = vntArray(1, 2)
For lngRow = 2 To UBound(vntArray, 1)
If vntArray(lngRow, 2) = strTemp2 Then
If vntArray(lngRow, 1) = strTemp1 Then vntArray(lngRow, 2) = ""
Else
strTemp2 = vntArray(lngRow, 2)
End If
If vntArray(lngRow, 1) = strTemp1 Then
If vntArray(lngRow, 2) = "" Then vntArray(lngRow, 1) = ""
Else
strTemp1 = vntArray(lngRow, 1)
End If
Next lngRow
'Daten eintragen und Blatt formatieren
With Sheets(1)
.Cells.UnMerge
.Cells.Borders.LineStyle = xlNone
.Range(.Cells(2, 1), .Cells(UBound(vntArray, 1) + 1, 3)) = vntArray
lngLast = .Cells(Rows.Count, 1).End(xlUp).Row
lngFirst = 2
'Zellen verbinden
For lngRow = 2 To lngLast - 1
If .Cells(lngRow + 1, 1) <> "" Then
.Range(.Cells(lngFirst, 1), .Cells(lngRow, 1)).Merge
.Range(.Cells(lngFirst, 2), .Cells(lngRow, 2)).Merge
lngFirst = lngRow + 1
End If
Next lngRow
lngLast = .Cells(Rows.Count, 3).End(xlUp).Row
.Range(.Cells(lngRow, 1), .Cells(lngLast, 1)).Merge
.Range(.Cells(lngRow, 2), .Cells(lngLast, 2)).Merge
'Rahmen rein
With .Range("A1").CurrentRegion
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
.VerticalAlignment = xlCenter
End With
End With
Set rngTemp = Nothing
Application.ScreenUpdating = True
End Sub
Die Progs von Max brauchst du weiterhin!
Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe

Vielen Dank!!
1A. Werd mich mal durch die Scripte arbeiten und versuchen es zu verstehen!!!
DANKE !!!

Hallo,
viel Spaß dabei.
Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe

Hi,
also ein wenig steig ich inzwischen durch,
das sortieren kapier ich jedoch überhaupt nicht. Da ist auch noch ein kleiner Fehler:
Die Reihenfolge der Ergebnisse (Werte) sollte natürlich NICHT sortiert werden, sondern nur dem Test und Prüfer zugeordnet bleiben. Wie kann ich das ändern?
Gruß,
Stefan
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige