Suche Formel/Makro, schwierig zu umschreiben

Hallo,
ich bin auf der Suche nach einer Formel bzw. besser wohl einem Makro das folgendes macht.
Spalte 1 Eine Reihe von Zahlen gleicher länge.
Spalte 2 Eine Anzahl
Spalte 3 Wieder eine Zahl
In etwa so
123 3 789
235 5 956
745 1 668
Nun soll daraus automatisch an die Zahl in Spalte 1 eine fortlaufende Zahl angehängt werden mit der Häufigkeit wie in Spalte 2 angegeben. Und die Zahl aus Spalte 3 soll in eine neue Spalte kopiert werden ebenfalls mit der entsprechenden Häufigkeit.
123-1 689
123-2 689
123-3 689
235-1 956
235-2 956
235-3 956
235-4 956
235-5 956
745-1 668
Wie bekomme ich Excel dazu dies zu machen?
Weitere Schwierigkeit, es können auch Leerzeilen auftretten und die Liste soll dennoch weiter abgearbeitet werden.
Gruß
Joker

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

' ********************************************************************** ' Modul: Modul1 Typ: Allgemeines Modul ' ********************************************************************** Option Explicit Sub newList() Dim vntIn As Variant, vntOut() As Variant Dim lngIndex As Long, LngC As Long, lngN As Long With ActiveSheet vntIn = .Range("A1:C" & .Cells(.Rows.Count, 1).End(xlUp).Row) LngC = Application.Sum(.Columns(2)) Redim vntOut(1 To LngC, 1 To 2) LngC = 1 For lngIndex = 1 To UBound(vntIn, 1) If vntIn(lngIndex, 1) <> "" And IsNumeric(vntIn(lngIndex, 2)) Then For lngN = 1 To vntIn(lngIndex, 2) vntOut(LngC, 1) = vntIn(lngIndex, 1) & "-" & lngN vntOut(LngC, 2) = vntIn(lngIndex, 3) LngC = LngC + 1 Next End If Next .Range("E1").Resize(UBound(vntOut, 1), 2) = vntOut End With End Sub

Hallo Jocker,
viel gibt e da nicht zu beschreiben.

Sub newList()
  Dim vntIn As Variant, vntOut() As Variant
  Dim lngIndex As Long, LngC As Long, lngN As Long
  
  With ActiveSheet
    'letzte Zeile in A bestimmen und Bereich an Array zuweisen
    vntIn = .Range("A1:C" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    'Summe der Zahlen in Spalte B bilden, entspricht der Zeilenanzahl der Ausgabe
    LngC = Application.Sum(.Columns(2))
    'Ausgabearray dimensionieren
    Redim vntOut(1 To LngC, 1 To 2)
    
    LngC = 1
    
    'Array durchlaufen
    For lngIndex = 1 To UBound(vntIn, 1)
      'wenn eintrag in 1. Spalte und zahl in 2. Spalte dann
      If vntIn(lngIndex, 1) <> "" And IsNumeric(vntIn(lngIndex, 2)) Then
        'Eintrag nach Anzahnl in Spalte 2 erstellen
        For lngN = 1 To vntIn(lngIndex, 2)
          vntOut(LngC, 1) = vntIn(lngIndex, 1) & "-" & lngN
          vntOut(LngC, 2) = vntIn(lngIndex, 3)
          LngC = LngC + 1
        Next
      End If
    Next
    'Ausgabe
    .Range("E1").Resize(UBound(vntOut, 1), 2) = vntOut
  End With
  
End Sub

« Gruß Sepp »

Beliebteste Forumthreads (12 Monate)

Suche Formel/Makro, schwierig zu umschreiben

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread