Sie sind aktuell nicht angemeldet.

Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Re: Mein Anfänger-Code
Autor: Lutz Ebbing
Datum: 17.01.02 10:07
So sieht es aus, ich glaube es haut auch hin.Nur wenn ich Nachnamen mit "Ö; Ü oder Ä als Anfangsbuchstaben habe stehen diese immer am Ende. Danke für die Mühe schon im voraus. 'Im Modul deklariert: Public Nachname(500) As String Public Vorname(500) As String Public Telefon1(500) As String Public Adresse(500) As String Public PLZ(500) As String Public Ort(500) As String Public MaxAnzahl As Integer ' ------------------------------------------------------------------------------------- Public Sub QuickSort(vSort As Variant, _ Optional ByVal lngStart As Variant, _ Optional ByVal lngEnd As Variant) If IsMissing(lngStart) Then lngStart = LBound(vSort) If IsMissing(lngEnd) Then lngEnd = UBound(vSort) Dim I As Long Dim j As Long Dim h As Variant Dim x As Variant I = lngStart: j = lngEnd x = vSort((lngStart + lngEnd) / 2) ' Array aufteilen Do While (vSort(I) < x): I = I + 1: Wend While (vSort(j) > x): j = j - 1: Wend If (I <= j) Then ' Wertepaare miteinander tauschen h = vSort(I) vSort(I) = vSort(j) vSort(j) = h I = I + 1: j = j - 1 End If Loop Until (I > j) ' Rekursion (Funktion ruft sich selbst auf) If (lngStart < j) Then QuickSort vSort, lngStart, j If (I < lngEnd) Then QuickSort vSort, I, lngEnd End Sub '---------------------------------------------------------------------------------------- 'In der Form: Private Sub CmdExit_Click() Unload Me End Sub '------------------------------------------------------------------------------------------- Private Sub CmdSortieren_Click() Dim sTemp() As String Dim sItem() As String Dim nCount As Long Dim I As Long Dim Position As Integer ' temporäres Array erzeugen nCount = MaxAnzahl 'UBound(Nachname) '(Name) ReDim sTemp(nCount) For I = 1 To nCount sTemp(I) = Nachname(I) _ & vbTab & Vorname(I) _ & vbTab & Telefon1(I) _ & vbTab & Adresse(I) _ & vbTab & PLZ(I) _ & vbTab & Ort(I) Next I ' Array via QuickSort sortieren QuickSort sTemp(), 1, nCount ' Array jetzt wieder "auseinanderlegen" Position = 0 For I = 1 To nCount Step 1 Position = Position + 1 sItem = Split(sTemp(I), vbTab) Nachname(Position) = sItem(0) Vorname(Position) = sItem(1) Telefon1(Position) = sItem(2) Adresse(Position) = sItem(3) PLZ(Position) = sItem(4) Ort(Position) = sItem(5) Next I 'Speicherbereich freigeben (löschen) Erase sTemp Erase sItem 'Ausgabe in ein ListView With ListView1 For Index = 1 To nCount Step 1 Set itemX = .ListItems.Add(, , Index) itemX.SubItems(1) = Nachname(Index) itemX.SubItems(2) = Vorname(Index) itemX.SubItems(3) = Telefon1(Index) itemX.SubItems(4) = Adresse(Index) itemX.SubItems(5) = PLZ(Index) itemX.SubItems(6) = Ort(Index) Next End With End Sub '--------------------------------------------------------- Private Sub Form_Load() Pfad$ = App.Path If Right$(Pfad$, 1) <> "\" Then Pfad$ = Pfad$ + "\" Else Pfad$ = Pfad$ End If dbDatenbank.datPrimaryRS.DatabaseName = Pfad$ + "DatenbankDatenbank.mdb" dbDatenbank.datPrimaryRS.RecordSource = "Adressen" dbDatenbank.datPrimaryRS.Refresh dbDatenbank.datPrimaryRS.Recordset.MoveFirst MaxAnzahl = 0 For Index = 1 To 200 Step 1 If dbDatenbank.datPrimaryRS.Recordset.Fields("Nachname") = "" Or IsNull(dbDatenbank.datPrimaryRS.Recordset.Fields("Nachname")) Then Nachname(Index) = "" 'MaxAnzahl = MaxAnzahl Exit For 'verläßt die Schleife Else Nachname(Index) = dbDatenbank.datPrimaryRS.Recordset.Fields("Nachname") MaxAnzahl = MaxAnzahl + 1 End If If dbDatenbank.datPrimaryRS.Recordset.Fields("Vorname") = "" Or IsNull(dbDatenbank.datPrimaryRS.Recordset.Fields("Vorname")) Then Vorname(Index) = "" Else Vorname(Index) = dbDatenbank.datPrimaryRS.Recordset.Fields("Vorname") End If If dbDatenbank.datPrimaryRS.Recordset.Fields("Telefon1") = "" Or IsNull(dbDatenbank.datPrimaryRS.Recordset.Fields("Telefon1")) Then Telefon1(Index) = "" Else Telefon1(Index) = dbDatenbank.datPrimaryRS.Recordset.Fields("Telefon1") End If If dbDatenbank.datPrimaryRS.Recordset.Fields("Adresse") = "" Or IsNull(dbDatenbank.datPrimaryRS.Recordset.Fields("Adresse")) Then Adresse(Index) = "" Else Adresse(Index) = dbDatenbank.datPrimaryRS.Recordset.Fields("Adresse") End If If dbDatenbank.datPrimaryRS.Recordset.Fields("PLZ") = "" Or IsNull(dbDatenbank.datPrimaryRS.Recordset.Fields("PLZ")) Then PLZ(Index) = "" Else PLZ(Index) = dbDatenbank.datPrimaryRS.Recordset.Fields("PLZ") End If If dbDatenbank.datPrimaryRS.Recordset.Fields("Ort") = "" Or IsNull(dbDatenbank.datPrimaryRS.Recordset.Fields("Ort")) Then Ort(Index) = "" Else Ort(Index) = dbDatenbank.datPrimaryRS.Recordset.Fields("Ort") End If dbDatenbank.datPrimaryRS.Recordset.MoveNext Next With ListView1 .Checkboxes = True '***Schrift Fett*** .Font.Bold = False '***Umstellen auf "Report"-Ansicht*** .View = lvwReport '***Gitterlinien einfügen****** .GridLines = True '***Ganze Zeile markieren****** .FullRowSelect = True '***Spalten andere Reihenfolge***** .AllowColumnReorder = True '***Column-Headers hinzufügen*** .ColumnHeaders.Add , , "ID" .ColumnHeaders.Add , , "Name" .ColumnHeaders.Add , , "Vorname" .ColumnHeaders.Add , , "Telefon" .ColumnHeaders.Add , , "Adresse" .ColumnHeaders.Add , , "PLZ" .ColumnHeaders.Add , , "Ort" '***Ausrichtung*** .ColumnHeaders(1).Alignment = lvwColumnLeft .ColumnHeaders(2).Alignment = lvwColumnLeft .ColumnHeaders(3).Alignment = lvwColumnLeft .ColumnHeaders(4).Alignment = lvwColumnLeft .ColumnHeaders(5).Alignment = lvwColumnLeft .ColumnHeaders(6).Alignment = lvwColumnLeft .ColumnHeaders(7).Alignment = lvwColumnLeft '***Breite*** .ColumnHeaders(1).Width = 800 'ID .ColumnHeaders(2).Width = 1600 'Name .ColumnHeaders(3).Width = 1600 'Vorname .ColumnHeaders(4).Width = 800 'Telefon .ColumnHeaders(5).Width = 1600 'Adresse .ColumnHeaders(6).Width = 500 'PLZ .ColumnHeaders(7).Width = 1200 'Ort End With End Sub

String alphabetisch sortieren	276	Lutz Ebbing	30.12.01 09:22
Re: String alphabetisch sortieren	2.120	Dieter	30.12.01 11:21
Re: String alphabetisch sortieren	236	Lutz Ebbing	30.12.01 12:33
Re: String alphabetisch sortieren	2.216	Dieter	30.12.01 13:39
Re: String alphabetisch sortieren	221	Lutz Ebbing	16.01.02 18:04
Re: String alphabetisch sortieren	1.654	Dieter	16.01.02 23:44
Re: Mein Anfänger-Code	243	Lutz Ebbing	17.01.02 10:07
Re: Mein Anfänger-Code	1.695	Dieter	17.01.02 10:57
Re: Mein Anfänger-Code	222	Lutz Ebbing	17.01.02 13:07

Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden. Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  Gesamtübersicht

Suchen