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

Data ordenen

Status
Niet open voor verdere reacties.
A

Anica

Gebruiker
Lid geworden
22 okt 2008
Berichten
21
Hallo,

voor een onderzoek naar het verschil in hersenactiviteit tussen gezonde personen en personen die een hersenbloeding hebben gehad, voeren we QEEG metingen uit (hersenmetingen).
Per proefpersoon voeren we 13 metingen uit. Per meting meten we op 8 plaatsen op de schedel. Per plek op de schedel krijgen we 6 gemiddelde waardes uit. Een hele hoop data die we rechtstreeks uit onze QEEG software kunnen halen. Het probleem is alleen dat het softwareprogramma de data per persoon sorteert en dat we voor de analyse het per locatie moeten ordenen. Tot nu toe hebben we alle data per persoon handmatig vanuit de QEEG-software in excel geplakt en vervolgens elke regel handmatig geselecteerd en in een volgend werkblad geplakt. Een heleboel werk. Vandaag heb ik geprobeerd om een makro te schrijven. De data moeten we handmatig in Excel blijven plakken, maar dmv de makro wilde ik de ordening in de verschillende tabbladen automatisch laten verlopen. Dit is me gelukt. Alleen denk ik dat het effectiever kan: is het mogelijk om een lus te definiëren die het eerste tabblad doorloopt, de data wegschrijft en stopt wanneer er geen data meer staan?
Ter verduidelijking heb ik het excel doc toegevoegd met slechts 5 personen als voorbeeld (uiteindelijk kunnen het 50 personen of meer worden). Op tabblad 1 C3 t/m H3 moet komen te staan op tabblad 2 van B2 t/m G2. Op tabblad 1 C4 t/m H4 moet komen te staan op tabblad 3 van B2 t/m G2 etc.
Ook heb ik nog de makro toegevoegd die ik gemaakt hebt op een oefenbestand (excel file die ik heb toegevoegd is uiteindelijke bestand). Moet volgens mij effectiever kunnen....

Sub EO()
'
' EO Macro
'

'

Range("B1:G1").Select
Selection.Copy
Sheets("F3").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B2:G2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("F4").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B3:G3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("C3").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B4:G4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("C4").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B5:G5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("T7").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B6:G6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("T8").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B7:G7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("P3").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B8:G8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("P4").Select
Range("B2").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B10:G10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("F3").Select
Range("B3").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B11:G11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("F4").Select
Range("B3").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B12:G12").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("C3").Select
Range("B3").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B13:G13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("C4").Select
Range("B3").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B14:G14").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("T7").Select
Range("B3").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B15:G15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("T8").Select
Range("B3").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B16:G16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("P3").Select
Range("B3").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B17:G17").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("P4").Select
Range("B3").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B19:G19").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("F3").Select
Range("B4").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B20:G20").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("F4").Select
Range("B4").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B21:G21").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("C3").Select
Range("B4").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B22:G22").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("C4").Select
Range("B4").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B23:G23").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("T7").Select
Range("B4").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B24:G24").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("T8").Select
Range("B4").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B25:G25").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("P3").Select
Range("B4").Select
ActiveSheet.Paste
Sheets("data om te plakken").Select
Range("B26:G26").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("P4").Select
Range("B4").Select
ActiveSheet.Paste

End Sub


Alvast bedankt
Anica
 

Bijlagen

Laatst bewerkt:
Ik kan het bestand niet opslaan met de code dus geef ik je zo de macro.

Code: 
Sub Verdelen()
Dim lRij As Long
Dim lSRij As Long
    lRij = 3
    While Worksheets("Data om te plakken").Range("B" & lRij).Value <> ""
        WB = Worksheets("Data om te plakken").Range("B" & lRij).Value
        lSRij = Worksheets(WB).Range("B65536").End(xlUp).Row + 1
        Worksheets("Data om te plakken").Range("C" & lRij & ":H" & lRij).Copy Destination:=Worksheets(WB).Range("B" & lSRij)
        lRij = lRij + 1
    Wend
End Sub

Bovenstaande code zet de gegevens in de juiste werkbladen.

Met vriendelijke groet,


Roncancio
 
Hoi Roncancio,

bedankt voor je zeer snelle reactie. Ik heb jouw oplossing uitgeprobeerd. Het omzetten van de data gaat inderdaad automatisch alleen klopt de weergave nog niet.

In het tabblad F3 staan 13 keer de gegevens van C3:H3 van rij 3 uit het eerste tabblad.
In het tabblad F4 staan 13 keer de gegevens van C3:H3 van rij 12 uit het eerste tabblad etc (in plaats van 1 keer de gegevens van C3:H3 van rij 4 uit het eerste tabblad).

Ik zal proberen om eerst zelf voor een oplossing te zoeken... hopelijk lukt dit. Zo niet, dan zal ik het wel weer laten weten :)

Groet Anica
 
Anica zei:
Hoi Roncancio,

bedankt voor je zeer snelle reactie. Ik heb jouw oplossing uitgeprobeerd. Het omzetten van de data gaat inderdaad automatisch alleen klopt de weergave nog niet.

In het tabblad F3 staan 13 keer de gegevens van C3:H3 van rij 3 uit het eerste tabblad.
In het tabblad F4 staan 13 keer de gegevens van C3:H3 van rij 12 uit het eerste tabblad etc (in plaats van 1 keer de gegevens van C3:H3 van rij 4 uit het eerste tabblad).

Ik zal proberen om eerst zelf voor een oplossing te zoeken... hopelijk lukt dit. Zo niet, dan zal ik het wel weer laten weten :)

Groet Anica
Klik om te vergroten...

Ik ben zoals gewoonlijk uitgegaan van je bestand en je gegevens begonnen op regel 3.
Doordat de gegevens van F3, F4 etc voor elk onderdeel identiek zijn, lijkt het alsof de gegevens uit 1 rij komen.

Met vriendelijke groet,


Roncancio
 
Je hebt helemaal gelijk! Sorry, ik kom uit de psychologen-hoek dus dit is voor mij een geheel nieuw terrein!!! Het werkt perfect, dankjewel!!!
 
Anica zei:
Je hebt helemaal gelijk! Sorry, ik kom uit de psychologen-hoek dus dit is voor mij een geheel nieuw terrein!!! Het werkt perfect, dankjewel!!!
Klik om te vergroten...

Geen probleem:thumb: Graag gedaan.
Gaarne de vraag op opgelost zetten.
Bvd.

Met vriendelijke groet,


Roncancio
 
Hoi Roncancio,

nog een laatste vraag. Vanochtend ben ik begonnen met het invoeren van data. De eerste 3 proefpersonen gaan perfect. Wanneer ik echter meer proefpersonen invul krijg ik een foutmelding:

Fout 9 tijdens uitvoering
Het subscript valt buiten het bereik

Wanneer ik op Foutopsporing klik, wordt er aangegeven onderstaande regel voor 'problemen' zorgt:
lSRij = Worksheets(WB).Range("B65536").End(xlUp).Row + 1

Weet jij hoe dit kan? Zo ja, als je er tijd voor hebt, zou je dit willen uitleggen? Ik probeer namelijk de achtergrond te begrijpen zodat ik dit in de toekomst hopelijk zelf kan oplossen.

Dank
Anica
 
Anica zei:
Hoi Roncancio,

nog een laatste vraag. Vanochtend ben ik begonnen met het invoeren van data. De eerste 3 proefpersonen gaan perfect. Wanneer ik echter meer proefpersonen invul krijg ik een foutmelding:

Fout 9 tijdens uitvoering
Het subscript valt buiten het bereik

Wanneer ik op Foutopsporing klik, wordt er aangegeven onderstaande regel voor 'problemen' zorgt:
lSRij = Worksheets(WB).Range("B65536").End(xlUp).Row + 1

Weet jij hoe dit kan? Zo ja, als je er tijd voor hebt, zou je dit willen uitleggen? Ik probeer namelijk de achtergrond te begrijpen zodat ik dit in de toekomst hopelijk zelf kan oplossen.

Dank
Anica
Klik om te vergroten...
Welke waarde staat er bij iSRIJ ?
Zou het kunnen dat er bij de 4e persoon naar een tabblad wordt verwezen die nog niet in het werkblad staat?

Met vriendelijke groet,


Roncancio
 
Voor zover ik weet wordt er niet naar een ander tabblad verwezen. Ik voeg de sheet met nieuwe getallen toe (zonder macro, want ik kan het bestand met macro niet toevoegen, geeft aan dat het een ongeldig bestand is).
 

Bijlagen

Anica zei:
Voor zover ik weet wordt er niet naar een ander tabblad verwezen.
Klik om te vergroten...

Toch wel:p
Er wordt verwezen naar het werkblad T3 dat er niet bij staat.

De macro gaat regel voor regel in Data om te plakken zoeken naar het tabblad waarvan de naam in de B-kolom staat.
De gegevens die er achter staan worden in dat tabblad geplaatst.
Je kunt dus ongehinderd tabbladen toevoegen en door elkaar zetten.
Indien gewenst kan ik de code aanpassen waarbij gecontroleerd wordt of het tabblad bestaat. Doordat de tabbladen al waren ingevoerd heb ik die controle niet in de code gezet.

Met vriendelijke groet,


Roncancio
 
Laatst bewerkt:
Ahaaaaaa, nu snap ik het al beter! Wanneer ik de naam T3 in T7 verander, werkt het inderdaad allemaal! Het feit dat er T3 staat heeft te maken met een verkeerde instelling in onze software. Het zou erg fijn zijn wanneer je nog die controle regel zou kunnen toevoegen, maar het hoeft niet persee, dan moet ik gewoon extra goed opletten! Je hebt me al heel erg geholpen!

Heel erg bedankt.

Anica
 
of

Code: 
Sub Verdelen()
  on error resume next
  For Each cl in Worksheets("Data om te plakken").columns(2).specialcells(xlcelltypeconstants)
    c0 = Sheets(cl.value).[A1]
    If Err.Number > 0 Then
      With Sheets.Add
         .Name = cl.value
      End With
    End If
    err.clear
    cl.offset(,1).resize(,6).copy sheets(cl.value).cells(rows.count,2).end(xlup).offset(1)
  Next
End Sub
 
Laatst bewerkt:
Anica zei:
Ahaaaaaa, nu snap ik het al beter! Wanneer ik de naam T3 in T7 verander, werkt het inderdaad allemaal! Het feit dat er T3 staat heeft te maken met een verkeerde instelling in onze software. Het zou erg fijn zijn wanneer je nog die controle regel zou kunnen toevoegen, maar het hoeft niet persee, dan moet ik gewoon extra goed opletten! Je hebt me al heel erg geholpen!

Heel erg bedankt.

Anica
Klik om te vergroten...

Ik heb de controleregels toegevoegd.
Als een tabblad niet wordt gevonden, worden de betreffende regels in Data om te plakken rood weergegeven.

Sub Verdelen()
Code: 
Dim lRij As Long
Dim lSRij As Long
    lRij = 3
    On Error Resume Next
    While Worksheets("Data om te plakken").Range("B" & lRij).Value <> ""
        WB = Worksheets("Data om te plakken").Range("B" & lRij).Value
        If IsError(Len(Sheets(WB).Name)) Then
            Worksheets("Data om te plakken").Range("B" & lRij & ":H" & lRij).Interior.Color = vbRed
        Else
            lSRij = Worksheets(WB).Range("B65536").End(xlUp).Row + 1
            Worksheets("Data om te plakken").Range("C" & lRij & ":H" & lRij).Copy Destination:=Worksheets(WB).Range("B" & lSRij)
        End If
        lRij = lRij + 1
    Wend
End Sub

Met vriendelijke groet,


Roncancio
 
Heel erg bedankt voor de geweldige hulp! Ik zal de vraag nu op 'opgelost' zetten!

Groet Anica
 
Anica, dit is een geprikt klusje voor Roncancio :P
Hij OWNED:thumb::thumb::thumb:
Komt allemaal in orde bij hem hoor
 
Roncancio zei:
:o
Is je stageverslag al klaar ?:p:p

Met vriendelijke groet,


Roncancio
Klik om te vergroten...

Ja, verslag heb ik al af, dit is gwoon extra punt om aan mijn leraar te laten zien dat ik me goed ingezet heb :D
(die zeiken altijd dat me niets intresseert, kan ik er wat aan doen dat ik de computer altijd belangrijker is :P)
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan