VBA - Zahlen von-bis als Textstring

Hallo liebe Excel-Profis,
ich wende mich heute mit einer sehr speziellen Anforderung an euch, für die mir komplett der Ansatz fehlt.
Ich habe eine Excel Datei eines Kollegen geerbt, in der jeden Tag ein spezieller Textstring ausgegeben wird, basierend auf Tagen, die in einer Liste stehen. Bisher ist das händisch geschehen und mich würde interessieren, ob man das per VBA morgens automatisieren kann.
Folgendes ist gegeben:
- Eine Liste von Tagen, die unsortiert vorliegt. Bspw in Zelle A2-A11:
1
2
3
18
24
4
5
6
7
10
Und folgende Anforderungen zur Generierung des Textstrings bestehen nun:
Anforderung 1:
Zusammenfassen aller Zahlen die in Reihenfolge stehen und mit Bindestrich trennen
Anforderung 2:
alle weiteren Tage die nicht in die Reihenfolge passen kommasepariert aufzählen
Anforderung 3:(nice to have)
den letzten Tag mit einem "und #Tag" separat ausweisen
Das Ergebnis würde im obigen Fall wie folgt aussehen:
Dies sind die Tage 1-7,10,18 und 24
Leider weiß ich nicht wie ich das Problem strukturell angehen soll, vielleicht hat jemand von euch gute Ideen? Ich freue mich über jede Hilfe.
Liebe Grüße
nik

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Faulpelz() Dim s As String, i As Integer, n As Integer Dim Test As Variant Test = Array(1, 2, 3, 18, 24, 4, 5, 6, 7, 10) Cells(1, 1).Resize(UBound(Test) + 1) = Application.Transpose(Test) With WorksheetFunction s = .Small(Columns(1), 1) For i = 2 To .CountA(Columns(1)) n = .Small(Columns(1), i) If n = .Small(Columns(1), i - 1) + 1 Then s = s & "-" & n ElseIf n = .Max(Columns(1)) Then s = s & " und Tag " & n & "." Else s = s & ", " & n End If Next End With Cells(2, 3) = "Dies sind die Tage " & s End Sub

Hallo Manuel/Nik,
gibt es auch dazwischen Intervalle?: 1-5, 7, 9-12, 24 und 30
was passiert wenn die 2 letzten in einer Reihe sind? 1, 3, 5-8, 11 und 12 oder 1, 3, 5-8, 11-12 (eigentlich 1, 3, 5-8 und 11-12, oder?)
Ich habe die letzte Version implementiert.
Es ist eine User Defined Function ("UDF"), spricht ein VBA-Code, das wie eine Excel-Formel gerufen wird. Kopiere den Code in ein Modul (nicht Blatt- oder Mappe-Codepane). Die übergegebene Liste muss zuerst sortiert werden, daher BubbleSort
Testaufbau:
in A1:A31 die Formel =ZUFALLSZAHL()
in B1:B13 die Formel =RANG(A1;$A$1:$A$31)
in C1 die Formel =TextString(B1:B13)
13 Eingangswert, weil 5 zu wenig un 20 zu viel sind.
Beispielergebnisse:
1, 5, 8, 10, 13, 16, 21-24, 26, 28 und 31
1, 3-4, 6, 8-10, 13-14, 18, 20-21 und 30
4, 7, 12-13, 16, 19, 24-25 und 27-31
1, 6-9, 13, 16, 20, 25 und 28-31


Public Function TextString(ByVal Target)
Dim Arr()
Dim i
Dim Erg As String
If Target.Rows.Count > 1 And Target.Columns.Count > 1 Then TextString = Error(): Exit Function 'Darf nur einspaltig oder einzeilig sein
'sortieren
Arr = Application.Transpose(Target)
Arr = BubbleSort(Arr)
'erste
Erg = Arr(LBound(Arr))
'rest
For i = LBound(Arr) + 1 To UBound(Arr)
If Arr(i) = Arr(i - 1) + 1 Then
If Right(Erg, 1)  "-" Then Erg = Erg & "-"
If i = UBound(Arr) Then Erg = Erg & Arr(i)
Else
If Right(Erg, 1) = "-" Then Erg = Erg & Arr(i - 1)
Erg = Erg & ", " & Arr(i)
End If
Next
'Ergebnis zusammenfassen
i = InStrRev(Erg, ",")
TextString = Left(Erg, i - 1) & " und" & Mid(Erg, i + 1)
End Function
Public Function BubbleSort(Arr())
Dim i, j
Dim Tmp
For i = LBound(Arr) To UBound(Arr) 'lngLz
For j = i + 1 To UBound(Arr) 'lngLz
If Arr(i) > Arr(j) Then
Tmp = Arr(i)
Arr(i) = Arr(j)
Arr(j) = Tmp
End If
Next
Next
BubbleSort = Arr
End Function

VG
Yal

Beliebteste Forumthreads (12 Monate)

VBA - Zahlen von-bis als Textstring

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

316 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA - Zahlen von-bis als Textstring

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

316 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread