Zahlen nach den letzten 2 Ziffern suchen
11.01.2016 11:33:32
Gregor
Ich habe eine Liste, in der in Spalte 6 in beliebiger Reihenfolge vierstellige Zahlen stehen. Die übrigen Spalten enthalten andere Daten. In Spalte 6 stehen 2 oder 3 Zahlen mit den gleichen Endziffern, also zB.2100, 5300, 3400 (hier 00) oder zB. 6501, 1701, 3201 (hier 01), usw. Ich möchte nun einige Zellinhalte (ua. die Zahlen Spalte 6) aller Zahlen chronologisch nach den Endziffern 00, 01, bis 99 sortiert auf einem neuen Blatt darstellen. Es ist auch möglich, dass nicht immer alle Endziffern 00, 01, bis 99 vorkommen.
Ich bastelte folgenden Code, dieser berücksichtigt mit "Part" natürlich alle Zahlen in denen dieser Part vorkommt und nicht nur diejenigen, welche die zwei Endziffern enthalten. Wie kann ich das lösen?
Sub Bündeln_und_sortieren()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim arrFind
Dim z As Variant, y As Variant
Dim Zeile As Double, i As Double, Anzahl As Double, n As Double
Dim rZelle As Range
Dim sFundst As String
With Worksheets("Muster").Columns(6)
Anzahl = 6 'entspricht Anzhahl zu übernehmende Spalten
ReDim arrFind(1 To Anzahl, 1 To 1000)
n = 0
For i = 0 To 9 '98
z = Array("00", "01", "02", "03", "04", "05", "06", "07", "08", "09") 'usw. bis 99
Set rZelle = .Find(what:=z(i), lookat:=xlPart, LookIn:=xlValues)
If Not rZelle Is Nothing Then
sFundst = rZelle.Address
Do
n = n + 1
arrFind(1, n) = rZelle.Offset(, -5)
arrFind(2, n) = rZelle.Offset(, -4)
arrFind(3, n) = rZelle.Offset(, -3)
arrFind(4, n) = rZelle.Offset(, -2)
arrFind(5, n) = rZelle
arrFind(6, n) = rZelle.Offset(, 1)
Set rZelle = .FindNext(rZelle)
Loop While Not rZelle Is Nothing And rZelle.Address sFundst
End If
Next i
End With
Worksheets("Muster2").Cells(2, 1).Resize(n, Anzahl) = WorksheetFunction.Transpose(arrFind)
End Sub
Gregor
Anzeige