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

code blijft doordraaien en stopt niet

Status
Niet open voor verdere reacties.
G

grema

Gebruiker
Lid geworden
2 dec 2006
Berichten
659
code blijft doordraaien en stopt niet

Code: 
Sub SemiTranspose5()
Dim i As Long, y As Long
Dim x As Integer
    
    i = 1
    y = 1

    Do Until IsEmpty(Cells(y, 1))
        For y = 2 To 2
            
            Cells(y, x + 10).Value = Cells(i, 11).Value
            y = y + 1
            Cells(y, x + 10).Value = Cells(i, 12).Value
            y = y + 1
            Cells(y, x + 10).Value = Cells(i, 13).Value
            y = y + 1
            Cells(y, x + 10).Value = Cells(i, 14).Value
            y = y + 1
            Cells(y, x + 10).Value = Cells(i, 15).Value
            y = y + 1
            Cells(y, x + 10).Value = Cells(i, 16).Value
            y = y + 1
        Next y
        y = y + 1
        
    Loop

End Sub



waarom ????
 
Dit vind ik behoorlijk vreemde code, daar snap ik de bedoeling niet van. Maar goed de reden waarom deze code niet stopt is omdat je y eerst op 1 zet.
cel A1 is waarschijnlijk niet leeg, en dus duikt hij in de loop. Daar definieer je dat y moet lopen van 2 tot 2. Wat ik heel raar vind, want dan heb je eigenlijk geen loop nodig. Dan voer je een paar bewerkingen uit, waardoor je y waarde vergroot tot 8. Y is dan 8 en dan wil je y weer laten lopen van 2 tot 2. Dat snap ik echt niet.
Als je uit de loop komt verhoog je y nog eens met 1, en ga dan kijken of A9 (=cells(9,1)) leeg is, die is blijkbaar niet leeg, en je duikt weer in die loop van daarnet. Daar weer y is 2 tot 2, en zoverder.
Je blijft dus eigenlijk constant binnen dezelfde range van cellen. en altijd check je of A9 leeg is, maar die is blijkbaar niet leeg, dus constant weer die loop in. Dat is dus een oneindige loop.
 
Finch

Kan je me dan even uitleggen wat er moet staan als je weet dat :

ik op rij 2 wens in te voegen .

Want van volgende code ( = probeersel zie ik de bomen niet door het bos )

Code: 
Sub SemiTranspose5()
Dim i As Long, y As Long
Dim x As Integer
    
    i = 1
    y = 1

    Do Until IsEmpty(Cells(y, 1))
        For y = 2 To 2

grema
 
Hallo Grema,

je zal je vraag toch iets duidelijker moeten omschrijven (liefst met voorbeeldbestand) wil je geholpen worden. Want ik snap niks van je opzet.
 
Je kan dat doen via de functie transponeren, maar dan niet afsluiten met enter, maar dan met ctr, shift + enter. Je kan daarvoor ook gewoon een functie schrijven zoals bv.

Code: 
[FONT="Courier New"]Function WaardeOphalen(Cel As Range, Aantal As Long)
If Cel.Rows.Count > 1 Or Cel.Columns.Count > 1 Then
    WaardeOphalen = "Gelieve maar 1 cel te selecteren"
Else
    WaardeOphalen = Cel.Offset(, Aantal).Value
End If
End Function[/FONT]

en dan bv. gebruiken in je sheet als volgt.
Stel je wil de 3 waarden van naast cel B7, staan hebben in cellen A7 tem A9.

In A7 komt dan "=WaardeOphalen($B$7;1)"
In A8 "=WaardeOphalen($B$7;2)"
In A9 "=WaardeOphalen($B$7;3)"

Een procedure schrijven kan natuurlijk ook, maar in je voorbeeldbestand vond ik niet duidelijk waar beginnen en waar te stoppen. Dus als je dat wilt dien je dat beter te specifieren.
 
In m'n vb moet uiteindelijk de loop draait de loop (ook al is deze fout) voor regel A
KOLOM J

Daar zet ik de kolommen K L M N O onder elkaar

Tot daar gaat ie.

Nu wil ik volgende lijnen meenenen in deze loop.
dus regel 8 en de waarde IN CEL K 8 ; L 8 ; M 8 ; N 8 ;O 8

ook onder elkaar krijgen.

Dit voor een gans Blad

Hoe doe ik dit dan ???
 
heb er volgende van gemaakt ;

Nadeel moet dus telkens een manuele aanpassing doen .

eerst code :
Code: 
Sub SemiTranspose10()
Dim i As Long, y As Long
Dim x As Integer
    
    i = 1879
    y = 1879
    Do Until IsEmpty(Cells(y, 1))
        For y = 1880 To 1880
            Cells(y, x + 31).Value = Cells(i, 32).Value
            y = y + 1
            Cells(y, x + 31).Value = Cells(i, 33).Value
            y = y + 1
            Cells(y, x + 31).Value = Cells(i, 34).Value
            y = y + 1
            Cells(y, x + 31).Value = Cells(i, 35).Value
            y = y + 1
            Cells(y, x + 31).Value = Cells(i, 36).Value
            y = y + 1
            Cells(y, x + 31).Value = Cells(i, 37).Value
            y = y + 1
            Cells(y, x + 31).Value = Cells(i, 38).Value
            y = y + 1
        Next y
        y = y + 0
    Loop

dan aanpassen naar :

Code: 
Sub SemiTranspose10()
Dim i As Long, y As Long
Dim x As Integer
    
    i = 1887
    y = 1887
    Do Until IsEmpty(Cells(y, 1))
        For y = 1888 To 1888
            Cells(y, x + 31).Value = Cells(i, 32).Value
            y = y + 1
            Cells(y, x + 31).Value = Cells(i, 33).Value
            y = y + 1
            Cells(y, x + 31).Value = Cells(i, 34).Value
            y = y + 1
            Cells(y, x + 31).Value = Cells(i, 35).Value
            y = y + 1
            Cells(y, x + 31).Value = Cells(i, 36).Value
            y = y + 1
            Cells(y, x + 31).Value = Cells(i, 37).Value
            y = y + 1
            Cells(y, x + 31).Value = Cells(i, 38).Value
            y = y + 1
        Next y
        y = y + 0


we verspingen dus telkens 8 lijnen.


Dit voor een gans tabblad. De mannuele aanpassing is volgens mij NIET logisch
Daar ik echter de juiste codes niet ken ; of juist kan interpreteren loop ik dus vast.

Hoop dat er dan toch iemand even kan bijspringen en dat m'n uitleg duidelijk is .

alvast dank


grema
 
In de hoop het goed begrepen te hebben, en uit de losse pols:

Code: 
[FONT="Courier New"]Sub SemiTranspose()
Dim iRow As Long
Dim iCol As Long
Dim iColDif As Long

iCol = 10

For iRow = 1 To ActiveSheet.UsedRange.Rows.Count Step 7
    For iColDif = 1 To 6
        ActiveSheet.Cells(iRow + iColDif, iCol) = ActiveSheet.Cells(iRow, iCol + iColDif)
    Next iColDif
Next iRow        
End Sub[/FONT]
 
Lukt niet


hoe en met wat moet ik het duidelijker maken.

grema
 
Finch ,


ok ; daar gaan we dan.


Het gaat over een klnten lijst met tel. nrs waar de nummers mooi naast elkaar staan.

AE = tel prive
AF= tel kantoor
AG = tel rechtstreeks
AH = fax prive
AI = fax kantoor
AJ = fax rechtstreeks
AK= GSM 1
AL = GSM 2



Via de help-mij site ben ik er achter geraakt dat ik 7 rijen kan tussen voegen.

Via m'n code ( die ik niet snap; maar samengepuzzeld heb) krijg ik het toch zover dat ik
de kolommen AF tot AL mooi onder de kolom AE krijg.
Waarbij je dan wel moet verstaan dat dit telkens voor slechts 1 rij gaat.
Zit nu aan rij 2647. Daarna telkens mannueel aanpassen.

Kan je volgen waarom ik al de ganse dag zoek naar een oplossing om te vereenvoudigen.

Heb je aan deze info voldoende????


grema
 
Ik heb me gebaseerd op je voorbeeld bestand en bijhorend uitleg waar je stelt dat Kolom J de "actiekolom" is. Wanneer dit steeds wijzigt zullen we een soort van input moeten vragen, maar als het altijd kolom AE is kunnen we gewoon dat in de code laten staan.

Nieuwe code:

Code: 
Sub SemiTranspose()
Dim iRow As Long
Dim iCol As Long
Dim iColDif As Long

iCol = 31

For iRow = 1 To ActiveSheet.UsedRange.Rows.Count Step 7
    For iColDif = 1 To 7
        ActiveSheet.Cells(iRow + iColDif, iCol) = ActiveSheet.Cells(iRow, iCol + iColDif)
    Next iColDif
Next iRow        
End Sub

Deze code wel uitvoeren op een kopie van je data, zodat je altijd kunt teruggaan naar de oorspronkelijk correcte situatie.

edit: ik neem aan dat die 7 lijnen tussen elke lijn met horizontale data reeds is aangemaakt.
 
Laatst bewerkt:
foutmelding op

Code: 
ActiveSheet.Cells(iRow + iColDif, iCol) = ActiveSheet.Cells(iRow, iCol + iColDif)

Heb gewoon code geplakt en even laten draaien.

Geeft dan bovenstaande foutmelding; slechts 1 lijn aangepastmet 7 sublijnen.
 
2 de fout :

tel nr in geselecteerde RIJ --- kolom AE weg.

Als hier een nummer staat zou dit behouden moeten blijven .
 
Heb je geen voorbeeldbestand, met de correct layout? Ik denk dat we dan sneller tot een oplossing gaan komen.
 
komt eraan ; moet eerst zwaar deleten

Complex iets van gemaakt .
 
zeer eenvoudig bestaandje zonder codes anders te zwaar.

Dus telkens stonden de rijen onder elkaar met gegevens van klant en nrs.
Reeds kolommen bijgevoegd
Zoals je zal zien oorspronkelijke nummers en daarna copy waarin nrs onder elkaar komen via m'n of jou code.

Telkens na een blok van 8 (ipv 7 rijen) , komen de gegevens van de volgende klant terug mooi op 1 lijn.

Deze zouden terug moeten worden opgesplits.
 

Bijlagen

finch,

jou code draait voor zover dat de juiste startplaats dient te worden ingegeven ;

maar de 1 ste lijn en daarvan telekens de eerste kolom wordt overschreven

Dit lijkt me voorlopig het enige probleem dat ik tegenkwam
 
Op basis van je testbestand, denk ik dat dit doet wat je voor ogen had:

Code: 
[FONT="Courier New"]Sub SemiTranspose()
Dim iRow As Long
Dim iCol As Long
Dim iColDif As Long

iCol = 31

For iRow = 2 To ActiveSheet.UsedRange.Rows.Count Step 8
    For iColDif = 1 To 7
        ActiveSheet.Cells(iRow + iColDif, iCol) = ActiveSheet.Cells(iRow, iCol + iColDif)
    Next iColDif
Next iRow
        
End Sub[/FONT]
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan