AW: Nochmal Makro --> Brauche Hilfe
24.07.2003 13:00:57
Nepumuk
Hallo Florian,
so geht's z.B.:
Option Explicit
Public Sub Florian()
Dim Feld() As Single, Zelle As Range, zaehler As Single, Merker As String
Dim index As Single, Anzahl As Single
For Each Zelle In ActiveSheet.UsedRange
If Trim(Zelle) <> "" And IsNumeric(Zelle) Then
zaehler = zaehler + 1
ReDim Preserve Feld(1 To zaehler)
Feld(zaehler) = Zelle
End If
Next
If zaehler <> 0 Then
Call sortieren(1, UBound(Feld), Feld)
For index = 1 To zaehler
If CStr(Feld(index)) <> Merker Then
Anzahl = Anzahl + 1
Merker = CStr(Feld(index))
End If
Next
End If
MsgBox CStr(Anzahl) & " verschiedene Zahlen sind in der Tabelle.", 64, "Information"
End Sub
Private Sub sortieren(Untergrenze As Long, Obergrenze As Long, Feld() As Single)
Dim index1 As Long, index2 As Long, Element As Single, Zwischenspeicher As Single
index1 = Untergrenze
index2 = Obergrenze
Zwischenspeicher = Feld(((Untergrenze + Obergrenze) / 2) \ 1)
Do
Do While Feld(index1) < Zwischenspeicher
index1 = index1 + 1
Loop
Do While Zwischenspeicher < Feld(index2)
index2 = index2 - 1
Loop
If index1 <= index2 Then
Element = Feld(index1)
Feld(index1) = Feld(index2)
Feld(index2) = Element
index1 = index1 + 1
index2 = index2 - 1
End If
Loop Until index1 > index2
If Untergrenze < index2 Then Call sortieren(Untergrenze, index2, Feld())
If index1 < Obergrenze Then Call sortieren(index1, Obergrenze, Feld())
End Sub
Code eingefügt mit: Excel Code Jeanie
Gruß
Nepumuk