Office-Fragen.de

Normale Version: Daten nach Anzahl auflisten
Sie sehen gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Guten Abend,

ich habe den Auftrag Zahlenwerte untereinander aufzulisten, im Bezug auf einen Faktor.
z.B. steht in L15 2 und dieser Wert soll dann 3 mal untereinander geschrieben werden, ab A15
L16 ist 5 und soll dann z.B. 4 mal untereinander stehen und zwar direkt unter den aufgelisteten 2ern, also ab A18


Ich hoffe meine Beschreibung ist verständlich, falls nicht versuche ich mich anders zu formulieren.

Vielen Dank schon mal für eure Hilfe.

Mfg

flixx14
Hallo,

mit dem folgenden VBA-Makro lassen sich die Einträge wie gewünscht in Spalte A ab Zeile 15 auflisten.


Code:
Sub auflisten()

'** Dimensionierung der Variablen
Dim lngWert As Long
Dim lngZeile As Long

'** Vorgaben definieren
Set wsdat = ThisWorkbook.Sheets("Tabelle1")
lngZeile = 15

For a = 15 To wsdat.Cells(Rows.Count, 12).End(xlUp).Row
 
  '** Wert auslesen
  lngWert = wsdat.Cells(a, 12).Value
 
  '** Daten schreiben
  For b = 1 To lngWert
     
    '** Werte schreiben
    wsdat.Cells(lngZeile, 1).Value = lngWert
   
    '** Zeilenzähler erhöhen
    lngZeile = lngZeile + 1
  Next b

Next a

End Sub

Ich habe die Beispieldatei aus als Anlage beigefügt. Wenn du die Schaltfläche "Daten auflisten" klickst, wird der Code entsprechend ausgeführt.

Viele Grüße

Alois
(30.09.2019, 07:08)Officer schrieb: [ -> ]Hallo,

mit dem folgenden VBA-Makro lassen sich die Einträge wie gewünscht in Spalte A ab Zeile 15 auflisten.


Code:
Sub auflisten()

'** Dimensionierung der Variablen
Dim lngWert As Long
Dim lngZeile As Long

'** Vorgaben definieren
Set wsdat = ThisWorkbook.Sheets("Tabelle1")
lngZeile = 15

For a = 15 To wsdat.Cells(Rows.Count, 12).End(xlUp).Row
 
  '** Wert auslesen
  lngWert = wsdat.Cells(a, 12).Value
 
  '** Daten schreiben
  For b = 1 To lngWert
     
    '** Werte schreiben
    wsdat.Cells(lngZeile, 1).Value = lngWert
   
    '** Zeilenzähler erhöhen
    lngZeile = lngZeile + 1
  Next b

Next a

End Sub

Ich habe die Beispieldatei aus als Anlage beigefügt. Wenn du die Schaltfläche "Daten auflisten" klickst, wird der Code entsprechend ausgeführt.

Viele Grüße

Alois

Vielen Dank für die Arbeit.
Ich glaube das ich mich falsch ausgedrückt habe, Entschuldigung.
Ich habe mal eine Tabelle gemacht wie ich es eigentlich gemeint habe.
Das nächste Mal drücke ich mich sofort richtig aus.
[Bild: Daten.png]

Hallo,

ist vom Prinzip ja das gleiche, nur andere Spalten Wink

Hier der geänderte Code und die Beispieldatei.


Code:
Sub auflisten()

'** Dimensionierung der Variablen
Dim lngWert As Long
Dim lngZeile As Long

'** Vorgaben definieren
Set wsdat = ThisWorkbook.Sheets("Tabelle1")
lngZeile = 15

'** Ausgabebereich löschen
wsdat.Range("A15:C1000").ClearContents

'** Werte n Mal eintragen
For a = 15 To wsdat.Cells(Rows.Count, 12).End(xlUp).Row
 
  '** Wert auslesen
  lngWert = wsdat.Cells(a, 15).Value
 
  '** Daten schreiben
  For b = 1 To lngWert
     
    '** Werte schreiben
    With wsdat
      .Cells(lngZeile, 1).Value = wsdat.Cells(a, 12).Value 'Wert 1
      .Cells(lngZeile, 2).Value = wsdat.Cells(a, 13).Value 'Wert 2
      .Cells(lngZeile, 3).Value = wsdat.Cells(a, 14).Value 'Wert 3
     
   
    End With
   
    '** Zeilenzähler erhöhen
    lngZeile = lngZeile + 1
  Next b

Next a

End Sub

Gruß Alois
(30.09.2019, 15:37)Officer schrieb: [ -> ]Hallo,

ist vom Prinzip ja das gleiche, nur andere Spalten Wink

Hier der geänderte Code und die Beispieldatei.


Code:
Sub auflisten()

'** Dimensionierung der Variablen
Dim lngWert As Long
Dim lngZeile As Long

'** Vorgaben definieren
Set wsdat = ThisWorkbook.Sheets("Tabelle1")
lngZeile = 15

'** Ausgabebereich löschen
wsdat.Range("A15:C1000").ClearContents

'** Werte n Mal eintragen
For a = 15 To wsdat.Cells(Rows.Count, 12).End(xlUp).Row
 
  '** Wert auslesen
  lngWert = wsdat.Cells(a, 15).Value
 
  '** Daten schreiben
  For b = 1 To lngWert
     
    '** Werte schreiben
    With wsdat
      .Cells(lngZeile, 1).Value = wsdat.Cells(a, 12).Value 'Wert 1
      .Cells(lngZeile, 2).Value = wsdat.Cells(a, 13).Value 'Wert 2
      .Cells(lngZeile, 3).Value = wsdat.Cells(a, 14).Value 'Wert 3
     
   
    End With
   
    '** Zeilenzähler erhöhen
    lngZeile = lngZeile + 1
  Next b

Next a

End Sub

Gruß Alois
Cool danke.

Das funktioniert einwandfrei.
Von VBA habe ich leider absolut keine Ahnung.