Suche Formel/Makro, schwierig zu umschreiben

Forumthread: Suche Formel/Makro, schwierig zu umschreiben

06.10.2012 16:58:31

AcJoker

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

AW: Suche Formel/Makro, schwierig zu umschreiben

06.10.2012 17:12:07

Josef

Hallo Jocker,
teste mal (Daten in A1:Cx, Ausgabe ab E1)

' **********************************************************************
' 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

« Gruß Sepp »

AW: Suche Formel/Makro, schwierig zu umschreiben

06.10.2012 17:21:09

AcJoker

Weltklasse, das ging ja mal fix und funktioniert wunderbar. Danke.
Auch wenn es sicher viel verlangt ist, aber könntest du das Makro etwas erklären oder mir beschreiben wie du es erstellt hast?

AW: Suche Formel/Makro, schwierig zu umschreiben

06.10.2012 18:31:45

Josef

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

Forumthread: Suche Formel/Makro, schwierig zu umschreiben

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Suche Formel/Makro, schwierig zu umschreiben

Forumthread: Suche Formel/Makro, schwierig zu umschreiben

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

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread