Array-Einträge vor Ausgabe sortieren

Forumthread: Array-Einträge vor Ausgabe sortieren

Joni

Hallo,
ich lese mit
Set MyDic = CreateObject("Scripting.Dictionary")
arr = Sheets("Erfassung-Rechnung").Range("M16:M20000") 'Suchbereich
For lngL = 1 To UBound(arr, 1) 'Schleife über die Zeilen
For intI = 1 To UBound(arr, 2) 'Schleife über die Spalten
MyDic(arr(lngL, intI)) = 0
Next
Next
die Werte aus einem Tabellenbereich aus. Jetzt stellt sich die Frage wie kann ich die Werte vor der Ausgabe von klein nach groß sortieren? Es sind Zahlen und Buchstaben vorhanden (zB 1039, 1074, 2031, 3009, a, c, mv; die Reihenfolge ist durcheinander). Die Buchstabenwerte möchte ich ignorieren und die Zahlenwerte der Größe nach in einer Schleife für die Weiterverarbeitung ausgeben. Die Ausgabe funktioniert nur die Sortierung bereitet mir noch Probleme.
Danke für eure Hilfe.
Gruß Joni

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Array-Einträge vor Ausgabe sortieren

07.09.2010 09:08:14

JogyB

Hallo Joni,
so weit ich weiß geht es nicht direkt, Du musst es in einen eindimensionalen Array schreiben und dann sortieren. Wobei wir dann bei dem Punkt wären, ob Du überhaupt das Dictionary-Objekt oder nicht gleich einen Array verwenden solltest. Da ich den Rest des Codes nicht kennen weiß ich jetzt nicht, ob Du es an anderer Stelle brauchst.
Übrigens: Was soll den mit den Texten passieren? Kommen die einfach unsortiert nach hinten oder fliegen die komplett raus?
Gruß, Jogy

AW: Array-Einträge vor Ausgabe sortieren

07.09.2010 09:25:51

Joni

Hallo Jogi,
hier der ganze Code (PDF_drucken wird verwendet um jeweils die aktuelle Ansicht in eine PDF-Datei zu drucken). Die Ausgabe erfolgt derzeit in der Reihenfolge wie die Werte "gefunden" werden. Ich sollte sie aber der Größe nach haben. Die Buchstabenwerte können komplett ausgelassen/ignoriert/übersprungen werden. Das sind nur Zusatzinfos die ich mir am Ende von Hand rausziehe.

Public Sub MobHMAusdruckautomatisch_alle_Eintraege()
Dim MyDic As Object
Dim arr As Variant
Dim Element As Variant
Dim lngL As Long
Dim intI As Integer
Dim RGNRSTART As Integer
Dim ICOL As Variant
Dim IROW As Variant
Dim SUMMEB As Variant
Dim RF As Integer
Dim WM As Integer
Dim NV As Integer
Dim HG As Variant
Dim ONR As Variant
Set MyDic = CreateObject("Scripting.Dictionary")
arr = Sheets("Erfassung-Rechnung").Range("M16:M20000") 'Suchbereich
For lngL = 1 To UBound(arr, 1) 'Schleife über die Zeilen
For intI = 1 To UBound(arr, 2) 'Schleife über die Spalten
MyDic(arr(lngL, intI)) = 0
Next
Next
'Ausgeben
RGNRSTART = Range("M5") - 1
ICOL = 1 'Spalte
IROW = Range("M4") 'Zeile
'MsgBox Join(MyDic.keys, vbCrLf)
For Each Element In MyDic.keys
Range("I8").FormulaR1C1 = Element
Selection.AutoFilter Field:=13, Criteria1:=Element
SUMMEB = Range("M6")
RF = Range("M7")
WM = Range("M8")
NV = Range("M9")
If SUMMEB  0 Then
RGNRSTART = RGNRSTART + 1
Range("C8").FormulaR1C1 = RGNRSTART
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Call PDF_Drucken
HG = Range("A1")
ONR = Range("I8")
SUMMEB = Range("M6")
With Sheets("Liste")
.Cells(IROW, ICOL).FormulaR1C1 = ONR
ICOL = ICOL + 1
.Cells(IROW, ICOL).FormulaR1C1 = HG
ICOL = ICOL + 1
.Cells(IROW, ICOL).FormulaR1C1 = RGNRSTART
ICOL = ICOL + 1
.Cells(IROW, ICOL).FormulaR1C1 = SUMMEB
ICOL = ICOL + 2
.Cells(IROW, ICOL).FormulaR1C1 = RF
ICOL = ICOL + 1
.Cells(IROW, ICOL).FormulaR1C1 = WM
ICOL = ICOL - 6
IROW = IROW + 1
End With
Sheets("Erfassung-Rechnung").Select
ElseIf NV  0 Then
Range("C8").FormulaR1C1 = ""
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Call PDF_Drucken
End If
Next
Application.ScreenUpdating = True
End Sub

Als workaround könnte ich die Werte aus dem Array in eine Tabelle schreiben, da sortieren und die "unbrauchbaren" Werte löschen, neu einlesen und dann ausgeben lassen. Ich dachte aber vielleicht gibt es eine elegantere Variante.
Gruß Joni

AW: Array-Einträge vor Ausgabe sortieren

07.09.2010 09:59:14

JogyB

Hallo Joni,
das solltest Du einfach in den bestehenden Code intergrieren können, ersetzt einfach den oberen Teil bis zur For-Schleife (die ist zur Veranschaulichung noch drin, aber ohne weiteren Code)

Sub einLesen()
Dim arr As Variant
Dim sortArr() As Double
Dim lngL As Long
Dim intI As Integer
Dim lngZaehler As Long
Dim Element As Variant
arr = Sheets("Erfassung-Rechnung").Range("M16:M20000") 'Suchbereich
' Array nach Anzahl der Zahlen dimensionieren
ReDim sortArr(1 To _
Application.Count(Sheets("Erfassung-Rechnung").Range("M16:M20000")))
For lngL = 1 To UBound(arr, 1) 'Schleife über die Zeilen
For intI = 1 To UBound(arr, 2) 'Schleife über die Spalten
' Liest nur Zahlen ein
If IsNumeric(arr(lngL, intI)) And Not IsEmpty(arr(lngL, intI)) Then
lngZaehler = lngZaehler + 1
sortArr(lngZaehler) = arr(lngL, intI)
End If
Next
Next
Call QuickSort(sortArr)
For Each Element In sortArr
' Dein weiterer Code
Next
End Sub

Du brauchst für das noch einen Sortier-Algorithmus, ich habe den hier genommen:

' Quicksort-Algorithmus - aufsteigend
Sub QuickSort(ByRef VA_Array, Optional V_Low1, Optional V_High1)
On Error Resume Next
Dim V_Low2 As Long, V_High2 As Long
Dim V_Val1, V_Val2 As Variant
If IsMissing(V_Low1) Then
V_Low1 = LBound(VA_Array, 1)
End If
If IsMissing(V_High1) Then
V_High1 = UBound(VA_Array, 1)
End If
V_Low2 = V_Low1
V_High2 = V_High1
V_Val1 = VA_Array((V_Low1 + V_High1) / 2)
While (V_Low2  V_Val1 And _
V_High2 > V_Low1)
V_High2 = V_High2 - 1
Wend
If (V_Low2  V_Low1) Then Call _
QuickSort(VA_Array, V_Low1, V_High2)
If (V_Low2

Der ist nicht von mir, den habe ich mal im Netz gefunden, weiß aber leider nicht mehr wo.
Gruß, Jogy

AW: Array-Einträge vor Ausgabe sortieren

07.09.2010 10:07:27

xr8k2

Hallo Ihr,
ich hab mir jetzt die Codes nicht durchgearbeitet ... aber irgendwas gelesen von Zahlen sortieren ohne enthaltene Buchstaben ... und das ganze in ein Array ...
Sowas kann man auch prima mit der Funktion "Small" evaluieren ....

 Dim arr As Variant
arr = Evaluate("transpose(small('Erfassung-Rechnung'!M16:M20000, row(1:" & _
Application.WorksheetFunction.Count(Sheets("Erfassung-Rechnung").Range("M16:M20000")) & ")))")

Im Array stehen dann alle in M16:M20000 enthaltenen Zahlen aufsteigend sortiert.
Gruß,
xr8k2

AW: Array-Einträge vor Ausgabe sortieren

07.09.2010 10:17:29

JogyB

Hallo xr8k2,
ist an sich eine schöne Lösung, nur die Laufzeit ist eine Katastrophe. Ich habe einfach mal den Bereich mit Zufallszahlen (ca. 7000 in dem Bereich), Leerzellen und Text gefüllt, da braucht meint Code ca. 0,16s und Deiner knapp 23s.
Gruß, Jogy

AW: Array-Einträge vor Ausgabe sortieren

07.09.2010 11:00:46

xr8k2

Hallo Jogy,
du hast vollkommen Recht ... die Laufzeit ist eine Katastrophe :-
Ich hatte lediglich den Umfang des Codes im Auge und ich habs auch mit so großen Datenmengen nicht getestet.
Aber bei diesen Laufzeitunterschieden stehts wohl außer Frage, ob man ein paar Codezeilen mehr im Modul stehen hat oder nicht ;-)
Gruß,
xr8k2

AW: Array-Einträge vor Ausgabe sortieren

07.09.2010 19:29:30

Joni

Hallo Jogy,
leider habe ich da noch ein paar Problemchen.
1. Mehrfacheinträge werden öfters ins Array geschrieben und somit auch mehrfach abgearbeitet.
2. Ist es möglich aus dem Bereich M16:M20000 nur jene Werte zu berücksichtigen die derzeit sichtbar sind (mit dem Autofilter werden einige Zeile ausgeblendet, da der ganze Durchlauf in 2 Teilen statt findet)?
Vielleicht hast du mir da auch noch einen Tip. Der Rest trifft meine Bedürfnisse schon sehr genau :-)
@xr8k2 Auch an dich ein Danke. Ich habe deine Version noch nicht getestet. Auf die 23 Sek. würde es zwar bei meinen ca. 2 Stunden Durchlaufzeit auch nicht mehr darauf ankommen. Aber man spart wo man kann :-)
Gruß Joni

AW: Array-Einträge vor Ausgabe sortieren

07.09.2010 21:23:15

Uduuh

Hallo,
zuzüglich 'Quicksort':

Public Sub MobHMAusdruckautomatisch_alle_Eintraege()
Dim MyDic As Object
Dim Element As Variant
Dim RGNRSTART As Integer
Dim ICOL As Variant
Dim IROW As Variant
Dim SUMMEB As Variant
Dim RF As Integer
Dim WM As Integer
Dim NV As Integer
Dim HG As Variant
Dim ONR As Variant
Dim arrKeys As Variant, rngC As Range
Set MyDic = CreateObject("Scripting.Dictionary")
For Each rngC In Sheets("Erfassung-Rechnung").Range("M16:M20000").SpecialCells( _
xlCellTypeVisible) 'Suchbereich
If IsNumeric(rngC) Then  'nur numerische Werte
MyDic(rngC.Value) = 0
End If
Next rngC
arrKeys = MyDic.keys
Quicksort arrKeys
'Ausgeben
RGNRSTART = Range("M5") - 1
ICOL = 1 'Spalte
IROW = Range("M4") 'Zeile
'MsgBox Join(MyDic.keys, vbCrLf)
For Each Element In arrKeys
Range("I8").FormulaR1C1 = Element
Selection.AutoFilter Field:=13, Criteria1:=Element
SUMMEB = Range("M6")
RF = Range("M7")
WM = Range("M8")
NV = Range("M9")
If SUMMEB  0 Then
RGNRSTART = RGNRSTART + 1
Range("C8").FormulaR1C1 = RGNRSTART
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Call PDF_Drucken
HG = Range("A1")
ONR = Range("I8")
SUMMEB = Range("M6")
With Sheets("Liste")
.Cells(IROW, ICOL).FormulaR1C1 = ONR
ICOL = ICOL + 1
.Cells(IROW, ICOL).FormulaR1C1 = HG
ICOL = ICOL + 1
.Cells(IROW, ICOL).FormulaR1C1 = RGNRSTART
ICOL = ICOL + 1
.Cells(IROW, ICOL).FormulaR1C1 = SUMMEB
ICOL = ICOL + 2
.Cells(IROW, ICOL).FormulaR1C1 = RF
ICOL = ICOL + 1
.Cells(IROW, ICOL).FormulaR1C1 = WM
ICOL = ICOL - 6
IROW = IROW + 1
End With
Sheets("Erfassung-Rechnung").Select
ElseIf NV  0 Then
Range("C8").FormulaR1C1 = ""
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Call PDF_Drucken
End If
Next
Application.ScreenUpdating = True
End Sub

Gruß ausm Pott
Udo

AW: Array-Einträge vor Ausgabe sortieren

08.09.2010 08:33:12

Joni

Hallo Udo,
ich hab das mal auf die Schnelle getestet. Es passt!
Danke für deine Hilfe! Gilt auch für die anderen!
Schöne Grüße
Joni

Beliebteste Forumthreads (12 Monate)

Array-Einträge vor Ausgabe sortieren

Forumthread: Array-Einträge vor Ausgabe sortieren

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread