Thema: Herausforderung, aus Userform Eingabe Zahlenreihen erstellen

Hallo zusammen,

ich versuche mal zu erklären wie der Plan ist, was nicht ganz einfach wird:

In einer Userform/Eingabemaske gebe ich Daten ein (links die Eingabe als Beispiel - recht die Erklärung was dabei raus kommen soll)

Zieltabelle hat 4 Spalten (Stadt, Straße,Hausnummer,Etage)

Stadt: z.B. 2 - In diesem Fall wäre in Spalte1 "Gebäude" überall die Zahl 2
Straße: z.B. 3,5-8,12 - Hier wäre die Auswahl: einmal die 3, je einmal die 5,6,7,8 und einmal die 12
Hausnummer: z.B. 8-12 - je einmal 8,9,10,11,12
Etage: z.B. 4,5 - einmal 4 einmal 5

Nun wird für jede Hausnummer ein Datensatz benötigt. Wir haben also immer die gleiche Stadt, 6 verschiedene Straßen (3,5-8,12), hier jeweils 5 mal
die Hausnummern 8,9,10,11,12 und das einmal in Etage 4 und einmal in Etage 5.
Diese Daten werden dann für die Weiterverarbeitung verwendet.

Im Anhang eine Datei um das zu veranschaulichen mit Beispieldaten.
Leider habe ich keinen Ansatz wie das umzusetzen geht.
Hoffe auf eure Hilfe.

Tabellenblatt Eingabe sollen die Daten eingegeben werden und im Blatt Ergebnis sieht man wie es danach aussehen sollte.


Hier die Datei https://www.herber.de/bbs/user/168673.xlsm

Vielen Dank für jede Idee

Chris

Hi
lege mal dieses Makro und die dazugehörige Funktion an.
nach der Eingabe startest du dann das Makro ListeErstellen.

Sub ListeErstellen()

Dim Stadt

Dim Straße

Dim HNr

Dim Etage

Sheets("Ergebnis").Cells(1, 1).CurrentRegion.Offset(1, 0).ClearContents

For Each Stadt In FolgeVollständig(Sheets("Eingabe").Cells(4, 3))

    For Each Straße In FolgeVollständig(Sheets("Eingabe").Cells(6, 3))

        For Each HNr In FolgeVollständig(Sheets("Eingabe").Cells(8, 3))

            For Each Etage In FolgeVollständig(Sheets("Eingabe").Cells(10, 3))

                Sheets("Ergebnis").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 4) = Array(Stadt, Straße, HNr, Etage)

            Next

        Next

    Next

Next

End Sub





Private Function FolgeVollständig(txt As String)

Dim x

Dim i As Long

Dim y As String

For Each x In Split(txt, ",")

    If x Like "*#-#*" Then

        For i = CLng(Split(x, "-")(0)) To CLng(Split(x, "-")(1))

            y = y & "," & i

        Next

        y = Mid(y, 2)

        txt = Replace(txt, x, y)

    End If

Next

FolgeVollständig = Split(txt, ",")

End Function

Gruß Daniel

Boah,

wie geil bist du denn. Die ersten Test ergaben das es perfekt funktioniert.

Ich habe zwar keine ahnung wie du das so schnell hinbekommen hast, aber echt genial.

Millionen Dank

Hi
danke für dein Feedback.
du bist ja nicht der erste, der solche abgekürzt beschriebenen Folgen vollständig haben will, dh da hat man schon ne Lösung im Kopf und der Rest ist Standard.
Gruß Daniel