Automatisch doorvoeren op basis van een kolom

[vinemaster]

Ik wil graag een bestand aanmaken op basis van een kolom door gebruik te maken van een macro.
een versimpeld voorbeeld staat hieronder:

Kolom
aap 3
noot 2
mies 4

Te maken bestand:
aap
aap
aap
noot
noot
mies
mies
mies
mies

Een beginnetje van de macro heb ik:

Sub Macro gegevens doortrekken()

Range("A1").Select
Dim test3 As String
test3 = InputBox("Welke naam", "Naam", ActiveCell.FormulaR1C1)

Range("B1").Select
Dim test4 As String
test4 = InputBox("Aantal keer", Aantal, ActiveCell.FormulaR1C1)

    Range("C1").Select
    ActiveCell.FormulaR1C1 = test3
    Range("C2").Select
    ActiveCell.FormulaR1C1 = test3
    Range("C1:C2").Select
    Selection.AutoFill Destination:=Range("C1:C" & test4), Type:=xlFillDefault
    Range("C1:C" & test4).Select
        
End Sub

Tevens denk ik dat ik hier ook iets mee kan/moet doen:

1.	Sub doorvoeren()
2.	    Dim C As Range
3.	    For Each C In Range("A:A")
4.	        If C = "" Then Exit Sub
5.	        If Len(C) = 3 Then C = C(0, 1)
6.	    Next C
End Sub

Kan iemand mij helpen om deze formule te laten werken?

 

[HSV]

Zet de aantallen in kolom B.

Sub hsv()
Dim sq, i As Long, j As Long, n As Long
With Sheets("Blad1")
sq = .Range("A1").CurrentRegion
ReDim arr(UBound(sq) * Application.Max(Columns(2)), 1)
     For i = 1 To UBound(sq)
     For j = 1 To sq(i, 2)
                arr(n, 0) = sq(i, 1)
                        n = n + 1
          Next j
       Next i
   .Range("J1").CurrentRegion.ClearContents
   .Range("J1").Resize(n) = arr
  End With
End Sub

 

[vinemaster]

Code werkt, maar...

HSV bedankt voor je code!
De aantallen stonden inderdaad in Kolom B en de code lijkt te werken.
Toch een aantal vragen:

Is er een reden waarom je de macro de gegevens in kolom J laat plaatsen?
Waarom verwijderd de macro alle overige gegevens die in het bestand staan?
Edit: (hiermee getest en het gaat vooral fout als kolom I is gevuld)


Na je antwoord zal ik mijn vraag op opgelost zetten!



P.s. uiteraard ben ik ook benieuwd naar welke gedeelte van de code wat doet, maar dat is geen noodzaak!

 

[Warme bakkertje]

Wil je het resultaat in kolom A dan ..

Sub hsv()
    Dim sq, i As Long, j As Long, n As Long
    With Sheets("Blad1")
        sq = .Range("A1").CurrentRegion
        ReDim arr(UBound(sq) * Application.Max(Columns(2)), 1)
        For i = 1 To UBound(sq)
            For j = 1 To sq(i, 2)
                arr(n, 0) = sq(i, 1): n = n + 1
            Next j
        Next i
        .Range("A1").CurrentRegion.Resize(, 1).ClearContents
        .Range("A1").Resize(n) = arr
    End With
End Sub

 

[vinemaster]

input wordt verwijderd

In kolom A staan de namen, in kolom B staan de aantallen, het had mij logisch geleken als de waardes dan in kolom C zouden komen.
Ik heb dit zelf ook aangepast in de Macro, dat is niet zo ingewikkeld, vroeg me alleen af of er met een specifieke reden voor kolom J was gekozen.

Wat me wel opvalt is dat alle 'input' wordt verwijderd, zodra de 'output' in een kolom staat die grenst aan een andere kolom met data.
Ik ben wel heel benieuwd waarom dit gebeurd, want als er op de achtergrond data wordt verwijderd zou dat nog wel vervelend kunnen zijn.

 

[Warme bakkertje]

het had mij logisch geleken als de waardes dan in kolom C zouden komen.

Een glazen bol hebben wij nog niet, dus ik veronderstel dat kolom J willekeurig gekozen was.

Wijzig dit

.Range("A1").CurrentRegion.Resize(, 1).ClearContents

in

.columns(3).clearcontents

en het probleem van verdwijnende data is opgelost.