For Next loopt niet door

Status
Niet open voor verdere reacties.
P

Peterjur

Gebruiker
Lid geworden
25 apr 2011
Berichten
105
Hallo,Ik ben met onderstaande procedure in de weer maar het wil maar niet doen wat ik wil???

HTML: 
Sub ToewijzenPosten()
      'Plaatst aan de hand van de Boeknummers de Posten in het grootboek per post
        Sheets("blad2").Select
        Dim answer As VbMsgBoxResult
        Dim VolgendeLetter As String
 For c = 1 To 27
        VolgendeLetter = Chr(64 + c)
  For t = 2 To 15
    For i = 1 To 60
      If Range("Q" & i).Value = t Then
         Range("R" & i).Copy Sheets("Blad2").Range(VolgendeLetter & c)
      End If
    Next i
  Next t
 Next c
      Sheets("Blad2").Select 
End Sub
In Excel op blad2 in kolom Q staan getallen van 1 tot 15
in kolom R staan bedragen

De beoeling is dat de bedragen aan de hand van de nummers in een bepaalde kolom
worden gezet.
De eerste 5 bedragen hebben het getal 2 en die worden naar kolom A gebracht en dan
wil de procedure niet verder is er iemand die dit snapt???

ik kom er niet uit bvd met groet Peter
 
Is dit niet gelijk aan deze vraag?
 
Hallo HSV,inderdaad is dit het onderstaande program,maar ik ben me er een ik heb hem
nog steeds niet lopend.Ik heb er van alles mee gedaan zonder resultaad Excuses daar voor.

HTML: 
Sub tst()
  For t = 1 To 15
  For i = 2 To 60
If Range("Q" & i).Value = t Then
   With Sheets("Blad2")
     .Cells(.Rows.Count, t).End(xlUp).Offset(1) = Range("I" & i)
       End With
      End If
    Next i
  Next t
End Sub
In kolom Q staan de nummers in kolom R de te verplaatsen bedragen.zou U mij nogmaals
op het goede pad willen brengen.mvg Peter
 
Als jij nu eens zou beginnen met een voorbeeldbestandje te posten
 
Kolom Q --- Kolom R ------- Kolommen A tm K B=2 C=3 enz
2 € (550,00) ------------- ----------- 550 Als het goed is verplaatst het program aan de hand van ----2--------- € (440.00)--------------------------------------de ---------------getallen in kolom Q de bedragen
2--------- € (1,00)--------------- uit kolom R naar de juiste kolomen.
2--------- € (1,00)
2--------- € 55,00
2--------- € (54,50)
3--------- € (275,18)
4--------- € (212,70)
5--------- € (116,65)
6--------- € (13,04)
6--------- € (26,07)
6 € (26,07)
6 € (41,70)
7 € (43,76)
8 € (25,80)

2 € 55,00
2 € (54,50)
3 € (275,18)
4 € (212,70)
5 € (116,65)
6 € (13,04)
6 € (26,07)
6 € (26,07)
6 € (41,70)
7 € (43,76)
8 € (25,80)
 
Laatst bewerkt:
Peter,

Een .xls bestandje graag, met wat gegevens, en hoe de gegevens moeten worden weggeschreven (handmatig erin zetten hoe het er uit moet zien), zegt meer dan jouw vorig schrijven.
 
Hsv,het lukt mij niet.Heb een excel blad op 50 % gezet en hier neer gezet,dat is geen sucses.Zorrij hoor en jammer voor mij.Een mens kan niet alles hebben he!!!

in ieder geval dank voor de aandacht.vr gr Peter;)
 
Maandelijkse-Vastelasten Insidentielelasten Resultaat-inkomste/uitgaven
Datum Levensm. Huur Zorg Energie Verzeker Tele2 Auto Totaal Omschrijving Diverse kruispost Reserve Bank
550,00 2 € (550,00)
2 € (1,00)

2 € 55,00
2 € (54,50)
550,00 0,00 0,00 0,00 0,00 0,00 0,00 550,00 0,00 0,00 0,00 0,00 3 € (275,18)
1 2 3 4 5 6 7 8 9 10 11 12 13 14 4 € (212,70)
5 € (116,65)
6 € (13,04)
6 € (26,07)
6 € (26,07)
6 € (41,70)
7 € (43,76)
8 € (25,80)
8 € (19,50)
8 € (14,00)
11 € (8,99)
11 € (11,52)
12 € 146,00
12 € 685,98
12 € 685,98
12 € 160,00
12 € (0,13)
13 € 150,00
13 € (100,00)
13 € (100,00)
€ 242,35
Dit is na 15% verkleinen.Hoe dan ook het komt niet goed.:evil:
 
Laatst bewerkt:
Een voorbeeld bestandje hoeft niet zo heel veel data te bevatten; genoeg om het probleem te reproduceren. En gezipt moet je toch een voldoende klein bestandje overhouden om mee te stoeien? Kortom: maak een werkbestandje...
 
Hallo helpers het is mij gelukt een voorbeeld te comprimeren.en het probleem is nu hoe
brengen wij dit bestandje in deze vraag.heb het bestandje gekopyeerd maar iedere keer
dat ik het dan wil plakken is hij er niet meer.Dom maar waar.kan iemand mij helpen bvd

vr.gr.Peter
 
Bij het plaatsen van een bericht klik je op de paperclip (middenboven, naast de gele smiley), de rest wijst zich vanzelf.
 
Hoi Peterjur,

Doet deze code misschien wat je wilt?

Gr, Mark.

ps. deze code is een bewerking van jouw code in post #3

Code: 
Sub onzin()
Const strcDelimiter As String = "|"
Dim vSource As Variant
Dim vData As Variant
Dim vResult(1 To 15) As Variant
Dim lngCnt As Long
Dim lngCol As Long
Dim lngResCol As Long
Dim vTransform As Variant
Dim rngCell
    
    vSource = Sheets("Blad1").Range("Q2:Q60")
    vData = Sheets("Blad1").Range("I2:I60")

    For lngCnt = LBound(vSource) To UBound(vSource)
        
        lngResCol = Abs(vSource(lngCnt, 1))
        
        If lngResCol <= 15 Then
            vResult(lngResCol) = vResult(lngResCol) & vData(lngCnt, 1) & strcDelimiter
        End If
    
    Next

    With Sheets("Blad2")
        .Range("A2", .Cells.SpecialCells(xlCellTypeLastCell)).ClearContents
    End With

    With Sheets("Blad2").Range("A2")
    
        For Each rngCell In .Resize(, UBound(vResult))
            
            vTransform = Split(vResult(rngCell.Column), "|")
            
            If UBound(vTransform) >= 0 Then
            
                rngCell.Resize(UBound(vTransform)) = _
                    WorksheetFunction.Transpose(vTransform)
            
            End If
            
        Next

    End With

End Sub
 
Laatst bewerkt:
HSV, Bekijk bijlage Map2.zip ,is het gelukt ik weet het niet?

Mark.Dank voor het prog.ben er mee aan de slag gegaan,begrijpen doe ik het niet ik probeer het wel te doorgronden.Onderstaande regel geeft steeds een fout.
Subscript valt buiten berijk.

Dat dot hij niet bij stap maar dan herhaald hij de If then regels steeds en doet in het bestand niets.Ik heb alle blad verwijzingen op blad1 gezet omdat ik dan meer controle op de zaak heb,ook heb ik deze kolommen aangepast.

vSource = Sheets("Blad1").Range("Q2:Q60")
vData = Sheets("Blad1").Range("R2:R60")



vResult(lngResCol) = vResult(lngResCol) & vData(lngCnt, 1) & strcDelimiter
HTML:

Ik blijf verder zoeken wat ik verkeerd doe.
 
deze macro hierboven doet inderdaad niets in het bestand. alleen als deze klaar is word informatie naar "Blad2" gekopieerd.

Bestaat er een "Blad1" en een "Blad2" in je werkmap?
 
Mark,ik heb het prog.weer in de oude staat hersteld,maar nog steeds krijg de Fout 9
Het subscript valt buiten berijk wat doe ik toch verkeerd.????

dank voor de snelle reactie mvgr Peter

ps
Ik heb inderdaad blad1 en blad2 in de map grootboek.
 
Nog twee dingen:

For c = 1 To 27
CHR(64+27) = "]"
Is dat het misschien?
verander je code naar 1 to 26

2:
gebruik altijd bladverwijzing bij je Range objecten. dus niet Range("Q2:Q60")
maar Sheets("Blad1").Range("Q2:Q60")

als een object niet bestaat krijg je een melding "subscript valt buiten het bereik".
Wees er zeker van dat de objecten waarnaar je refereert bestaan.
 
Dankzij de Geweldige Helpers ben ik er net als velen andere hulp zoekenden er uit.:thumb:Hieronder zet ik het resutaat van de inzet van al diegenen die mij op
de goede weg hebben gezet,dank daar voor.Ik zal niet eindigen voor ik U het
resultaat wat in ieder geval bij mij werk zoals ik het in mijn hoofd had.
Nogmaals dank.

Hier het uiteindelijke program dat werkt!!!


HTML:
Sub BedrNGrootb()
'Bedragen naar Grootboekrekeningen
For t = 2 To 15
For i = 1 To 60
If Range("Q" & i).Value = t Then
With Sheets("Blad1")
.Cells(.Rows.Count, t).End(xlUp).Offset(1) = Range("R" & i)
End With
End If
Next i
Next t
End Sub
HTML:

Met vriendelijke groet Peter.
 
Dan niet vergeten het als opgelost te zetten Peter.
Bvd.
 
HSV, Uitraard dat doe ik nu .Eigenlijk wilde ik dat doen als ik de vraag heb vergeleken
met de oplossing,wat deed ik verkeerd?? daar kan ik veel van leren en mischien andere ook.mvgr.Peter en nog bedankt voor de steun.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan