array an Function

[Rudi]

Hallo

ich habe in arrTemp() die Auftragsnummern eingelesen und möchte über
eine Function die Doppelten Auftragsnummern herausfiltern. Dann die
gefilterte Liste an arrAuf zurückgeben.
Kann man das so machen und wie muss man die Funktion schreibn?
Kann die Funktion auch ein array()as Long zurückgeben?

Sub Report01()
Dim arrAuf, arrTemp() As Long
...
ReDim arrTemp(1 to 4000)
'arrTemp einlesen alle

arrAuf = AuftragsNummernProKl(arrTemp)
...
End Sub

Private Function AuftragsNummernProKl(a() As Long) As Variant
???
AuftragsNummernProKl=
End Function

Sachdienliche Hinweise nimmt keine Polizeidienststelle entgegen,
sondern nur ich, die aber gern!

Gruß
Rudi

[Herbert Taferner]

Hallo Rudi,

wie wird den das arrTemp() eingelesen,

verwende eine Collection, in die keine doppelten
Werte aufgenommen werden können.

mfg Herbert

[unknown]

Hallo Rudi,
folgendes Beispiel um aus einem markierten Bereich eine Unikatliste zu
erstellen:

Sub KeineDublikate()
Dim rngZelle As Range
Dim NoDupes As New Collection
Dim Item As Variant
Dim intI As Integer

'Bei Fehler weitermachen
'Fehler tritt bei schon vorhandenem 'Key' in der Collection auf
On Error Resume Next

For Each rngZelle In Selection
'Key = CStr(rngZelle.Value) muß einmalig sein, sonst Fehler
'That's the trick: Das zweite Argument für die Add-Methode
'muss ein String sein!
NoDupes.Add rngZelle.Value, CStr(rngZelle.Value)
Next

'neues Blatt anlegen
Sheets.Add Before:=Sheets(1)

'jedes einmalige Element der Collection ausgeben
intI = 1
For Each Item In NoDupes
ActiveSheet.Cells(intI, 1).Value = Item
intI = intI + 1
Next
End Sub

MfG Frank
_________________________________________________
Frank Arendt-Theilen (ehem. MVP für Excel), Hameln
Microsoft Excel - Die ExpertenTipps: tinyurl.com/cmned
Website: xl-faq.de

[Rudi]

Hallo Frank, Hallo Herbert
das konnte ich nicht ahnen, sonst hätte ich mehr geschrieben.

Ein ganz toller Trick mit der Collection, das kannte ich nicht und kann
es gut gebrauchen, nur leider nicht hierfür.
Vielen Dank

Mein arrTemp(1 to 4000) ist ein Teil von arrA = .Range("c2:f4001),
welches ich rausgezogen habe um die Doppelten zu löschen, dann mit dem
Ergebnis der Funktion weiter zu arbeiten.
'arrTemp einlesen
For iAuf = 1 To UBound(arrA)
arrTemp(iAuf) = CLng(arrA(iAuf, 3))
Next

Deshalb werde ich doch über die Funktion gehen müssen, oder?

MfG

[Rudi]

Hallo Frank, Hallo Herbert

alles klar, jetzt hab ichs begriffen.

es geht!
Danke nochmal

MfG
Rudi

[Thomas Ramel]

Grüezi Rudi

Rudi schrieb am 21.10.2006

Post by Rudi
Ein ganz toller Trick mit der Collection, das kannte ich nicht und kann
es gut gebrauchen, nur leider nicht hierfür.
Mein arrTemp(1 to 4000) ist ein Teil von arrA = .Range("c2:f4001),
welches ich rausgezogen habe um die Doppelten zu löschen, dann mit dem
Ergebnis der Funktion weiter zu arbeiten.
'arrTemp einlesen
For iAuf = 1 To UBound(arrA)
arrTemp(iAuf) = CLng(arrA(iAuf, 3))
Next
Deshalb werde ich doch über die Funktion gehen müssen, oder?

Anstelle der Collection könntest Du die Unikate auch mittels Spezialfilter
ermitteln lassen. Schau dir hierzu mal die folgende Sub an; vielleicht
kannst Du daraus etwas ableiten:

Public Sub DoppelSort(rngBereich As Range)
'© Thomas Ramel / 14.06.2005
'Sub zum Eliminieren von Doubletten eines Bereiches
'Dieser wird als Parameter übergeben wird.
'Mittels Spezialfilter werden dann die Daten auf ein temporäres
'Blatt kopiert, dort gleich sortiert und in den zuvor gelöschten
'Bereich zurückgeschrieben.
'Aufruf z.B. wie folgt: DoppelSort Range("A1:D24")

Dim blnScr As Boolean
Dim blnDal As Boolean
Dim wsTemp As Worksheet

On Error GoTo ErrorHandler

blnScr = Application.ScreenUpdating
blnDal = Application.DisplayAlerts

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set wsTemp = Worksheets.Add

With rngBereich
.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=wsTemp.Range("A1"), _
Unique:=True
.ClearContents
End With

With wsTemp
.Range("A1").CurrentRegion.Sort Key1:=.Range("A1"), _
Order1:=xlAscending, _
Header:=xlYes
If Not .Range("A:A").Find(.Range("A1")) Is Nothing Then
.Range("A1").EntireRow.Delete
End If
.Range("A1").CurrentRegion.Copy rngBereich.Range("A1")
.Delete
End With

ErrorHandler:
Application.ScreenUpdating = blnScr
Application.DisplayAlerts = blnDal
End Sub


Sub DoppelSortTest()
DoppelSort Range("A1:D24")
End Sub


Mit freundlichen Grüssen
Thomas Ramel

[Rudi]

Hallo Thomas.
immerwieder erstaunlich, wieviele Wege nach Rom führen.
Das wusste ich auch vorher schon, aber schön, dass einem diese Wege
auch gezeigt werden.

Nun mein Hinkefuss:
Ich hab mir eine Liste mit 400 Datensätzen genommen
(Die Liste enthällt k e i n e Doppelten)
und ausgeführt:

Sub DoppelSortTest()
DoppelSort Range("A1:D400")
End Sub

Es wird immer die erste Zeile gelöscht!
Sie verschwindet einfach im Nirwana.
Lässt sich das erklären?

Ich durchschauh' die Sache noch nicht wirklich.
Deshalb frage ich zurück.
Kann es mit der Excel-Version zu tun haben?
Ich benutze Offi2000

MfG
Rudi

[Thomas Ramel]

Grüezi Rudi

Rudi schrieb am 22.10.2006

Post by Rudi
immerwieder erstaunlich, wieviele Wege nach Rom führen.
Das wusste ich auch vorher schon, aber schön, dass einem diese Wege
auch gezeigt werden.

Danke :-)

Post by Rudi
Ich hab mir eine Liste mit 400 Datensätzen genommen
(Die Liste enthällt k e i n e Doppelten)
Sub DoppelSortTest()
DoppelSort Range("A1:D400")
End Sub
Es wird immer die erste Zeile gelöscht!
Sie verschwindet einfach im Nirwana.
Lässt sich das erklären?

Aber ja doch:
Der Wert in A1 kommt auch in anderen Zellen der Spalte A noch vor, daher
wird die erste Zeile gelöscht, da diese beim Spezialfilter als
Spaltenüberschrift interpretiert wird.

Post by Rudi
Kann es mit der Excel-Version zu tun haben?
Ich benutze Offi2000

Nein, ich habe den Coe unter xl2000 entwickelt.

Am einfachsten fügst Du Spaltenüberschriften ein (die können auch als reine
Dummys dort stehen und nimmst dann den folgenden angepassten Code:

Public Sub DoppelSort(rngBereich As Range)
'© Thomas Ramel / 14.06.2005
'Sub zum Eliminieren von Doubletten eines Bereiches
'Dieser wird als Parameter übergeben wird.
'Mittels Spezialfilter werden dann die Daten auf ein temporäres
'Blatt kopiert, dort gleich sortiert und in den zuvor gelöschten
'Bereich zurückgeschrieben.
'Aufruf z.B. wie folgt: DoppelSort Range("A1:D24")

Dim blnScr As Boolean
Dim blnDal As Boolean
Dim wsTemp As Worksheet

On Error GoTo ErrorHandler

blnScr = Application.ScreenUpdating
blnDal = Application.DisplayAlerts

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set wsTemp = Worksheets.Add

With rngBereich
.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=wsTemp.Range("A1"), _
Unique:=True
.ClearContents
End With

With wsTemp
.Range("A1").CurrentRegion.Sort Key1:=.Range("A1"), _
Order1:=xlAscending, _
Header:=xlYes
.Range("A1").CurrentRegion.Copy rngBereich.Range("A1")
.Delete
End With

ErrorHandler:
Application.ScreenUpdating = blnScr
Application.DisplayAlerts = blnDal
End Sub


Mit freundlichen Grüssen
Thomas Ramel

[Rudi]

Hallo Thomas,

jetzt geht's
Danke für die Nacharbeit.

Mit freundlichen Grüssen
Rudi