• 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.

Loop in script

Status
Niet open voor verdere reacties.

Bjorkie

Gebruiker
Lid geworden
12 sep 2017
Berichten
147
Hey Allen,

ik heb een poging ondernomen om iets te bouwen, maar nu heb ik een loop die optreed.
ben nog een leek in VBA, dus alle swat ik staan heb, is met de hulp van jullie.
ik heb volgend probleem. op mijn tab2 (Camera List) heb ik een knop met een script achter. dit script zou de waarden uit tab1 (Calculation) halen, in zijn aantallen in de lijst plaatsen aan de linkse zijden (kolom B-C-D)
vervolgens, zal hij deze lijst weer filteren volgens unique waarden en de totaal aantallen in de rechter zijde plaatsen met hun aantallen (kolom I - J)
daarna moet hij de waarden van kolom I-J kopierern naar tab5 (Equipment List)

liefst een oplossing, maar ook een uitleg waardoor ik in deze looping kom?
als afzonderlijke script heeft het gewerkt. maar ik weet niet wat ik mis doe.

mijn gebruikte code is:

Code:
Sub Create_Camlist()

' Empty_CamList Macro
' Clear all data in CamList page.
    Worksheets("Camera List").Range("B5:D269").Select
    Selection.ClearContents
    
    Dim c As Range, i As Variant
    rij = 5
    For Each c In Sheets("Calculation").Range("B5:B500")
        If c.Offset(, 2) <> "Quant." 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)
                        .Cells(rij, 4) = c.Offset(, 15)
                  End With
                    
                End If
rij = rij + 1
            Next
        End If
' Create_Summary_List_Cameras Macro
'generate list on sheet 'Camera List'
     Worksheets("Camera List").Range("I5:I30").Select
     Selection.ClearContents
     Range("C5:C515").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "I5"), Unique:=True
'Copy Camera List to Equipment page
    Worksheets("Camera List").Range("I5:J30").Copy
    Worksheets("Equipment List").Range("A14").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Next
End Sub

Bekijk bijlage camera oefening v6.xlsm
 
Die laatste Next moet volgens mij onder de laatste END IF komen te staan en niet helemaal onderaan je code. Daardoor neemt hij je laatste twee handelingen mee in je eerste (For each c) Loop.
 
Laatst bewerkt:
Hey SjonR,
of ik begrijp niet goed welke je juist bedoeld. maar ik heb zo ongeveer alles geprobeerd, maar het lukt mij nog niet.
op zich, het script doet wel wat het moet doen, maar het is enorm arbeidsintensief voor Excel, en het beeld flikkert toch fel.
ik vermoed dat ik toch nog iets anders fout heb.
volgens mij, loopt het script automatisch door tot rij 500, maar indien er op mijn eerste tab, geen verdere waarden zijn, mag het stoppen.
je kan in het eerste tabblad, de quantity eens op 20 zetten, en dan laten lopen.
 
Probeer dit eens:
Code:
Sub Create_Camlist()

' Empty_CamList Macro
' Clear all data in CamList page.

Application.ScreenUpdating = False
    Worksheets("Camera List").Range("B5:D269").Select
    Selection.ClearContents
    
    Dim c As Range, i As Variant
    rij = 5
    For Each c In Sheets("Calculation").Range("B5:B500")
        If c <> "" And c.Offset(, 2) <> "Quant." 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)
                        .Cells(rij, 4) = c.Offset(, 15)
                  End With
                    
                End If
rij = rij + 1
            Next
        End If
    Next
' Create_Summary_List_Cameras Macro
'generate list on sheet 'Camera List'
     Worksheets("Camera List").Range("I5:I30").Select
     Selection.ClearContents
     Range("C5:C515").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "I5"), Unique:=True
'Copy Camera List to Equipment page
    Worksheets("Camera List").Range("I5:J30").Copy
    Worksheets("Equipment List").Range("A14").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
 
Perfect!! dank u wel.
deze doet het super.
ik stel enkel nog een eigenaardig iets vast.
bij het samenstellen van de rechter camera list op tab 'Cameralist', is de eerstre regel steeds dubbel weergegeven.
iemand dit al eens meegemaakt?
(misschien een ander ticket maken hiervoor?)
 
geen idee waarom het niet goed werkt, maar dit werkt wel voor je?

Code:
Sub Create_Camlist()

' Empty_CamList Macro
' Clear all data in CamList page.

Application.ScreenUpdating = False
    Worksheets("Camera List").Range("B5:D269").Select
    Selection.ClearContents
    
    Dim c As Range, i As Variant
    rij = 5
    For Each c In Sheets("Calculation").Range("B5:B7")
        If c <> "" And c.Offset(, 2) <> "Quant." 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)
                        .Cells(rij, 4) = c.Offset(, 15)
                  End With
                    
                End If
rij = rij + 1
            Next
        End If
    Next
    
' Create_Summary_List_Cameras Macro
'generate list on sheet 'Camera List'
     Worksheets("Camera List").Range("I5:I515").ClearContents
      Range("C5:C515").Copy Range("I5")
    Range("I5:I515").RemoveDuplicates 1, xlNo
'Copy Camera List to Equipment page
    Worksheets("Camera List").Range("I5:J30").Copy
    Worksheets("Equipment List").Range("A14").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
 
TOP!!
doet het prachtig.
ben nu nog wel aan het analyseren wat je aangepast hebt, en hoe ik dit moet verstaan.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan