Uitvullen a.d.h.v. aantal

Status
Niet open voor verdere reacties.

jansybe

Gebruiker
Lid geworden
22 apr 2022
Berichten
19
Hallo,

Ik ben op zoek naar VBA code die me kan helpen om een bepaalde lijst uit te vullen in een andere kolom.
Bijgaand een bestand om beter uit te leggen wat ik bedoel.

In kolom A vul ik een waarde in. In kolom B een aantal.

Ik zou graag een VBA code willen die ervoor zorgt dat in kolom C (Resultaat 1), alles wordt 'uitgevuld'. Dus dat de waarde die ik in kolom A invoer, net zo vaak onder elkaar gezet wordt als het aantal wat ik invul in kolom B. Een tweede is, dat ik in kolom D graag precies hetzelfde resultaat wil, maar dan -1. Dus in het geval van A100 in kolom C, 7 keer onder elkaar en in kolom D, 6 keer onder elkaar. En in het geval van P2938, in kolom dus niks omdat daar het aantal '1' is.

Ik hoop dat het zo een beetje duidelijk is. En ik hoop dat iemand me hiermee kan helpen! Het lukt me namelijk niet.

Bedankt in ieder geval alvast!

Groet!
 

Bijlagen

  • Uitvullen adhv aantal.xlsx
    9,2 KB · Weergaven: 10
zie de bijlage
 

Bijlagen

  • __Uitvullen snb.xlsx
    9,1 KB · Weergaven: 7
Misschien zo
 

Bijlagen

  • Uitvullen adhv aantal.xlsm
    25 KB · Weergaven: 5
Ook een duit.
Code:
Sub hsv()
Dim sv, hs, hsv, i As Long, c0 As String, s0 As String
 sv = Range("a1", Cells(Rows.Count, 2).End(xlUp))
        For i = 2 To UBound(sv)
         c0 = c0 & Replace(String(sv(i, 2), " "), " ", " " & i)
         s0 = s0 & Replace(String(sv(i, 2) - 1, " "), " ", " " & i)
        Next
     hs = Application.Transpose(Split(Trim(c0)))
     hsv = Application.Transpose(Split(Trim(s0)))
   Cells(2, 6).Resize(UBound(hs)) = Application.Index(sv, hs, 1)
   Cells(2, 7).Resize(UBound(hsv)) = Application.Index(sv, hsv, 1)
End Sub
 

Bijlagen

  • Uitvullen adhv aantal.xlsb
    15,2 KB · Weergaven: 7
Kan ook nog:
Code:
Sub hsv()
Dim r, a
 Cells(1).CurrentRegion.Offset(1).Columns(1).Name = "bereik"
    a = [offset(bereik,,2)].Value
    r = [offset(bereik,,2)].Address
 Cells(2, 10).Resize([sum(offset(bereik,,2))]) = Application.Transpose(Split(Join([transpose(rept(bereik&"|",offset(bereik,,2)))], ""), "|"))
   [offset(bereik,,2,counta(bereik))] = Evaluate(Replace("if(" & r & ">0,# -1,#)", "#", r))
 Cells(2, 11).Resize([sum(offset(bereik,,2))]) = Application.Transpose(Split(Join([transpose(rept(offset(bereik,,1)&"|",offset(bereik,,2)))], ""), "|"))
 [offset(bereik,,2)] = a
Application.Names("bereik").Delete
End Sub
 
In het voorbeeldbestand.
Code:
Sub hsv()
Dim r, a
 Cells(1).CurrentRegion.Offset(1).Columns(1).Name = "bereik"
    a = [offset(bereik,,1)].Value
    r = [offset(bereik,,1)].Address
 Cells(2, 10).Resize([sum(offset(bereik,,1))]) = Application.Transpose(Split(Join([transpose(rept(bereik&"|",offset(bereik,,1)))], ""), "|"))
   [offset(bereik,,1,counta(bereik))] = Evaluate(Replace("if(" & r & ">0,# -1,#)", "#", r))
 Cells(2, 11).Resize([sum(offset(bereik,,1))]) = Application.Transpose(Split(Join([transpose(rept(bereik&"|",offset(bereik,,1)))], ""), "|"))
 [offset(bereik,,1)] = a
Application.Names("bereik").Delete
End Sub
 

Bijlagen

  • Uitvullen adhv aantal 2e.xlsb
    16,5 KB · Weergaven: 2
In VBA:

Code:
Sub M_snb()
   sn = Cells(1).CurrentRegion
   ReDim sp([sum(B2:B7)], 1)
  
   For j = 2 To UBound(sn)
     For jj = 1 To sn(j, 2)
       sp(n, 0) = sn(j, 1)
       If jj < sn(j, 2) Then sp(n, 1) = sn(j, 1)
       n = n + 1
     Next
   Next
  
   Cells(2, 4).Resize(UBound(sp) + 1, 2) = sp
End Sub
 
Bedankt allemaal voor de hulp!!! Uiteindelijk heb ik de laatste optie gebruikt. Erg mooi dat jullie allemaal zo behulpzaam zijn. Het heeft mij erg veel werk bespaard! Dus nogmaals: Dank!

Groet!
 
Ik ben neiuwsgierig in wat voor soort gevallen je dit nodig hebt.
 
Het is nogal technisch, maar het gaat om het ophalen van plantmateriaal. Er worden lijsten gemaakt om een aantal planten te halen. Er is een lijst met 'gegroepeerde' plantaantallen, dus bijvoorbeeld nummer T1000 moet 5x worden gehaald. Daarnaast worden er ook labels afgedrukt van deze aantallen. Per plant moet een label komen, vandaar dat de lijst 'uitgevuld' moet worden.
 
Als je je toch al in het VBA-veld begeeft lijkt me dit overbodig. In VBA kan ik zoveel etiketten maken als nodig zonder daar eerst een werkblad mee te vullen.
 
Dat zou inderdaad ook kunnen. Het bestand wordt echter als .xlsx bestand ergens opgeslagen, waarna een andere afdeling de etiketten afdrukt (en de lijst). Maar ik zou willen dat ik VBA in zoverre zou beheersen dat ik dat op een meer eenvoudige manier zou kunnen doen.
 
Vertel hoe zo'n lijst er uit moet zien, of die bewaard moet worden en/of alleen afgedrukt; idem dito voor de etiketten.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan