• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

cel-waarde kopieren volgens getal in andere cel

Status
Niet open voor verdere reacties.

Bjorkie

Gebruiker
Lid geworden
12 sep 2017
Berichten
147
volgende situatie:
Sheet 1 is een lijst van artikels met naam en een aantal achter
Sheet 2: hier wil ik die artikels van sheet 1, maar in hun aantal keer.
voorbeeld:
Sheet 1:
auto 2
Bus 3

Sheet 2:
Auto
Auto
Bus
Bus
Bus

het is de bedoeling dat ik een verkorte lijst heb op sheet 1, en een volledige lijst op sheet 2.
(ben niet vertrouwd met VBA, maar probeer het wel)
de cellen in Sheet 1 bevatten reeds formules, dus ik wil enkel de inhoud op sheet 2, niet de links of formules.
 
Daar kan je beter even een voorbeeld doxument voor plaatsen.
 
Deze is daar voor gemaakt:
Code:
=AANTAL.ALS(Sheet2!A:A;Sheet1!A7)
 
Deze 'COUNTIF' functie geeft net het omgekeerde.
ik heb al een beknopte lijst met aantallen daar achter.
nu wil ik op een andere pagina, een lange lijst hebben.
als ik op sheet 1 volgende heb: Appels 5
dan wil ik op sheet 2
Appels
Appels
Appels
Appels
Appels

en hier onder, de aantal van de volgende lijn op sheet 1, enz

of wil ik hier iets onmogelijks? ;)
 
Ik kan het enkel via een macro

Code:
Sub cobbe()
rij = 3
For Each c In Sheets(1).Range("A7:A50")
 For i = 1 To c.Offset(, 1)
   Sheets(2).Cells(rij, 1) = c: rij = rij + 1
 Next
Next
End Sub

Er zal vast wel iemand dit via een matrixformule kunnen oplossen.
 

Bijlagen

  • test (cobbe).xlsb
    17,1 KB · Weergaven: 45
Hey Cobbe,
werkt leuk.
maar ik snap niet hoe ik het kan implementeren in mijn project.
(heb mijn project in bijlage)
'Bekijk bijlage camera oefening.xlsm

Op de 'calculation' sheet, heb ik mijn beknopte lijst.
deze wil ik expanderen op sheet 'camera list'
:shocked:
 
Kijk eens of deze foutloos loopt:
Code:
Sub cobbe()
    Dim c As Range, i As Variant
    rij = 5
    For Each c In Sheets("Calculation").Range("B6:B500")
        If c.Offset(, 2) <> "quantity" Then
           For i = 1 To c.Offset(, 2)
               If Left(c, 11) <> "Camera name" Then
                  If c.Offset(, 1) = "" And IsNumeric(c.Offset(, 2)) Then Exit Sub
                    With Sheets("Camera List")
                        .Cells(rij, 2) = c
                        .Cells(rij, 3) = c.Offset(, 1)
                    End With
                    
                End If
rij = rij + 1
            Next
        End If
    Next
End Sub
 
Laatst bewerkt:
Heb de code in #8 lichtjes aangepast zodat de code stopt bij eerste camera zonder beschrijving.
 
Hey Cobbe,

thanks maat.
echt super hoe je dit allemaal kan.
ik ken nog geen VBA, maar ben er wel door verrast.
zou je het erg vinden om mij nog wat verder te helpen met kleine zaken?
 
Geen probleem, dat geldt zeker ook voor de andere helpers,
wij kijken uit naar genoeg vragen.
En denk eraan er bestaan geen domme vragen, enkel domme antwoorden.:):)
 
ok, ik heb mijn vraag terug geopend. (of maak ik nieuwe aan?)
de code die ik gebruik in #8 werkt zeer goed.
maar ik zou nog als extra het volgende aan willen toevoegen.
Momenteel doen we 'creatie' van de lijst.
is een update mogelijk. stel ik pas iets aan op mijn 'source' pagina, dat dit dan ge-updated is?
kan ik met een simpele knop, de gehele lijstpagina leegmaken, om opnieuw te beginnen?
 
in de opgegeven code:
Code:
Sub cobbe()
    Dim c As Range, i As Variant
    rij = 5
    For Each c In Sheets("Calculation").Range("B6:B500")
        If c.Offset(, 2) <> "quantity" Then
           For i = 1 To c.Offset(, 2)
               If Left(c, 11) <> "Camera name" Then
                  If c.Offset(, 1) = "" And IsNumeric(c.Offset(, 2)) Then Exit Sub
                    With Sheets("Camera List")
                        .Cells(rij, 2) = c
                        .Cells(rij, 3) = c.Offset(, 1)
                    End With
                    
                End If
rij = rij + 1
            Next
        End If
    Next
End Sub

met deze code neem ik dus de waarden van kolom 2 & kolom 3 naar een nieuwe pagina.
maar wat moet ik toevoegen opdat ik ook de waarde van kolom 17 meeneem en deze in kolom 4 plaats op de pagina 'Camera List'
ik wil dus ook de waarde van kolom 3 meenemen.
 
Ik heb de invoeging van kolom Q ingevoegd.
Heb ook een REST & Update-knop ingevoegd.

Doe maar eens de test.
 

Bijlagen

  • camera oefening(cobbe).xlsm
    73 KB · Weergaven: 40
Laatst bewerkt:
is het mogelijk, dat je enkel een 'clear' doet op de 'geImporteerde velden'
aangezien we in kolom B & C & D iets importeren, zou ik mijn waarden van kolom 1, dewelke manuele ingaves zijn, niet willen verliezen
verder heb ik de functie al volledig geIntegreerd in mijn bestand, werkt verder zeer aangenaam.
 
Ja dat kan. Pas daarvoor deze code aan die in het werkblad Calculation staat:
Code:
Private Sub CommandButton1_Click()
 With Sheets("Camera List")
  .Range("[COLOR="#FF0000"][B]B5[/B][/COLOR]:D" & Range("B" & Rows.Count).End(xlUp).Row).ClearContents
 End With
cobbe
End Sub
 
Wat staat er verder allemaal aan reperterende code in?
Code:
Sub HideCam2()
    Range("rowsCam2").Select
    Selection.EntireRow.Hidden = True
    Range("quantityCam2").Select
    ActiveCell.FormulaR1C1 = "0"
    ActiveCell.Offset(-3, 0).Select
End Sub

Dit kan je toch net zo goed in 1 procedure 'vangen'?
bv
Code:
Sub HideCam(j As Long)
  Range("rowsCam" & j).EntireRow.Hidden = True
  Range("quantityCam" & j) = 0
End Sub

De code van Cobbe kan je nog vereenvoudigen tot
Code:
Sub VenA()
  For Each cl In Sheets("Calculation").Columns(4).SpecialCells(2, 1)
    If cl.Offset(, -1) <> "" Then
      For j = 1 To cl
        Sheets("Camera List").Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(, 3) = Array(cl.Offset(, -2), cl.Offset(, -1), cl.Offset(, 13))
      Next j
    End If
  Next cl
End Sub
 
Of met iets minder interactie.
Code:
Sub hsv()
Dim sn, sq, i As Long
 sn = Sheets("calculation").UsedRange
    For i = 2 To UBound(sn)
     If IsNumeric(sn(i, 4)) And sn(i, 3) <> "" Then c00 = c00 & Replace(String(sn(i, 4), " "), " ", " " & i)
    Next
    sq = Application.Transpose(Split(Trim(c00)))
 Sheets("Camera List").Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(UBound(sq), 3) = Application.Index(sn, sq, Array(2, 3, 17))
End Sub
 
@VenA: dit heb ik zelf niet geschreven. het komt er op neer, dat de bloks in Calculation Page, via een knop kunnen toegevoegd worden.
zelf had ik er 24 sets voorzien, die we telkens zichtbaar maken, of verbergen.
ideaal zou zijn dat die onbeperkt toegevoegd kunnen worden. (misschien is jouw toepassing daar beter voor.)
ik moet zeggen, van VBA ken ik zelf nog niets. ik probeer de codes te begrijpen, deze van Cobbe zijn 'redelijk' te verstaan als leek.

@HSV: bedankt voor de info. heb het getest en werkt ook deels. mijn vorig antwoord van Cobbe deed nog enkele kleine zaken meer en daar ik deze al geimplementeerd heb, ga ik het zo laten.
maar alvast bedankt om ook even te kijken en een knap voorstel te doen.

als er iemand mij graag nog verder helpt, wil ik gerust even uitleggen wat mijn volgende stappen zijn die ik wil bereiken. (skype; telefoon, mail,...)
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan