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

Macro kolommen kopiëren naar ander bestand in steeds een lege kolom

Status
Niet open voor verdere reacties.
M

MvdWorp

Gebruiker
Lid geworden
11 jun 2013
Berichten
27
Geachte forum-lid,

Graag wil ik een overzicht maken van mensen die ik gemeten heb op onze loopband.
Ik laad, per persoon, de gegevens van een .cvs-bestand in een excel bestand en voer dan de berekeningen uit. Vervolgens sla ik dit excel-bestand op, kopieer ik kolom (B) en sluit dit excel bestand.
Nu wil ik de gekopieerde kolom in een ander openstaand excel bestand kopiëren, waarbij de gekopieerde kolom uit het gesloten excel bestand steeds in een lege kolom moet worden gekopieerd.

Het eerste gedeelte gaat goed, maar nu worden de gekopieerde kolommen steeds op dezelfde kolom gekopieerd of het programma loopt vast; zie hieronder.
Wat doe ik fout en hoe kan ik ervoor zorgen dat steeds een lege kolom wordt gekozen? Ter info: Ik heb weinig/geen ervaring met VBA :)D)

-----------------------------
Sub MarcrovoorHulp()
'
'
mensen = InputBox("Hoeveel mensen wil je de gegevens van bewerken?")
For n = 1 To mensen
Wbnaam = "/Users/mij/Documents/Mensen" & n & ".csv"
Workbooks.Open (Wbnaam)

'Hier worden de bewerkingen uitgevoerd en vervolgens opgeslagen:

ActiveWorkbook.SaveAs FileName:="/Users/mij/Documents/Mensen" & n & ".xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False

Sheets("mensen" & n).Select
Columns("B:B").Select
Selection.Copy

Application.DisplayAlerts = False
ActiveWindow.Close SaveChanges:=True
Application.DisplayAlerts = True

ChDir "/Users/mij/Documents/AllesbijElkaar"
Sheets("TOTAAL").Select

Nr = Cells(Cells(ws.Columns.Count, "1").End(xlUp).Column, "1").Offset(1, 0).Select
Range("A" & Nr).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Next n

End Sub
-----------------------------------------------
 
Hallo.

Het helpt als je de code tussen tags (#) zet; wordt het allemaal een beetje beter leesbaar:

Code: 
Sub MarcrovoorHulp()
'
'
mensen = InputBox("Hoeveel mensen wil je de gegevens van bewerken?")
For n = 1 To mensen
Wbnaam = "/Users/mij/Documents/Mensen" & n & ".csv"
Workbooks.Open (Wbnaam)

'Hier worden de bewerkingen uitgevoerd en vervolgens opgeslagen:

ActiveWorkbook.SaveAs FileName:="/Users/mij/Documents/Mensen" & n & ".xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False

Sheets("mensen" & n).Select
Columns("B:B").Select
Selection.Copy

Application.DisplayAlerts = False
ActiveWindow.Close SaveChanges:=True
Application.DisplayAlerts = True

ChDir "/Users/mij/Documents/AllesbijElkaar"
Sheets("TOTAAL").Select

Nr = Cells(Cells(ws.Columns.Count, "1").End(xlUp).Column, "1").Offset(1, 0).Select
Range("A" & Nr).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Next n
End Sub

Wat ook helpt is een (klein) voorbeeldbestandje. :)
 
Je informatie is een beetje tegenstrijdig met je code, wil je elke nieuwe persoon in een nieuwe kolom of onderelkaar op een nieuwe rij.

ik ben uitgegaan van jou beschrijving dat in elke kolom een nieuwe persoon komt.

dan kom ik uit op.
Code: 
Sub MarcrovoorHulp()
'
'
mensen = InputBox("Hoeveel mensen wil je de gegevens van bewerken?")
For n = 1 To mensen
    Wbnaam = "/Users/mij/Documents/Mensen" & n & ".csv"
    Workbooks.Open (Wbnaam)
    
    'Hier worden de bewerkingen uitgevoerd en vervolgens opgeslagen:
    
    ActiveWorkbook.SaveAs Filename:="/Users/mij/Documents/Mensen" & n & ".xls", _
            FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    
    Sheets("mensen" & n).Columns("B:B").Copy
    
    Application.DisplayAlerts = False
        ActiveWindow.Close SaveChanges:=True
    Application.DisplayAlerts = True
    
    ChDir "/Users/mij/Documents/AllesbijElkaar"
    Sheets("TOTAAL").Range("A1").End(xlToRight).Offset(0, 1).PasteSpecial Paste:=xlPasteValues

Next n

End Sub

ook bij mij geldt: dit is ongetest omdat een voorbeeld bestand ontbreekt maar zou een eind in de richting moeten komen.
 
Laatste stapje ;)!

Dank voor jullie snelle reactie.
Roel klopt: elke mens/hardloper moet in een nieuw kolom in het overzichtsdocument!

Ik heb mijn originele macro aangepast. Helaas loopt hij nog vast bij het kopiëren....(de laatste bewerking van het proces)
Ik heb het originele bestand (beetje aangepast), met de macro, bijgevoegd. Zouden jullie nog een keer willen kijken waar het mis loopt?
Bedankt vast. Groet
 

Bijlagen

  • VerwerkingsProgramma voor Helpmij_nl.xlsm
    35,7 KB · Weergaven: 29
Best wel een nietszeggend voorbeeld. Waar is het .csv bestand?

Obv #1
Code: 
Sub MarcrovoorHulp()
  c00 = "/Users/mij/Documents/Mensen/"
  t = Application.InputBox("Hoeveel mensen wil je de gegevens van bewerken?", , , , , , , 1)
  If IsNumeric(t) Then
    For n = 1 To t
      With Workbooks.Open(c00 & n & ".csv")
        'Hier worden de bewerkingen uitgevoerd en vervolgens opgeslagen:
        ar = .Sheets("mensen" & n).Columns(2)
        .SaveAs c00 & n & ".xls", xlExcel8
        .Close 0
      End With
      Sheets("TOTAAL").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1) = ar
    Next n
  End If
End Sub
 
nu met .cvs bestand!

Sorry. Hierbij twee .cvs bestanden erbij.
 

Bijlagen

  • Hardloper1.csv
    4,7 KB · Weergaven: 19
  • Hardloper2.csv
    4,7 KB · Weergaven: 19
E staan drie suggesties voor andere code. Heb je er al iets mee gedaan?
 
Doet het nog niet goed

Beste VeNa,
Ik heb jou suggesties toegepast (zie attachment). Helaas loopt het programma vast: subscript "Sheets("DATATOTAAL").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1) = ar" valt buiten het bereik:eek:.

Heb je een suggestie? Bedankt vast voor de moeite.
Groet Maarten
 

Bijlagen

  • VerwerkingsProgramma voor Helpmij_nl2.xlsm
    36,6 KB · Weergaven: 26
ik heb de macro van VenA op een 4-tal punten gewijzigd (en ook nog hier en daar het path aangepast zodat het op mijn PC zou lopen).
Het eigenaardige van het verhaal is dat die 250 gegevens door 1 of andere gekke reden (bug?) in VenA's oorspronkelijke code om de 16.000 regels herhaald worden en daarom je buiten bereik valt.
Verder heb ik de code niet opgekuisd, die activate's en select's tot daar.
 

Bijlagen

  • VerwerkingsProgramma voor Helpmij_nl2.xlsm
    36,2 KB · Weergaven: 29
Ik heb de macro op heel veel punten gewijzigd. Alle selects en selections zijn overbodig. Het aanmaken van een nieuwe tab is ook niet nodig. Wel even het pad in c00 nog aanpassen.

Code: 
Sub VenA()
  c00 = "E:\Temp\Hardloper"
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  t = Application.InputBox("Voor hoeveel hardlopers wil je de gegevens van bewerken?", , , , , , , 1)
  If IsNumeric(t) Then
    For n = 1 To t
      If Dir(c00 & n & ".csv") <> "" Then
        With Workbooks.Open(c00 & n & ".csv").Sheets(1)
          With .Rows(1)
            .Cells(1, 2).Resize(, 5) = Array("Voorvoet li (N)", "Voorvoet re (N)", "Achtervoet li (N)", "Achtervoet re (N)", "Voorvoet li (%)")
            .Font.Bold = True
            .Resize(2).Copy
            .Cells(3, 1).PasteSpecial Transpose:=True
            .Resize(2).Delete
          End With
          With Cells(1).CurrentRegion
            .Cells(1, 2) = "Hardloper" & n
            .Font.Name = "Calibri"
            .Font.Size = 14
            .Columns.AutoFit
            ar = .Offset(, 1).Resize(, 1)
          End With
          .Parent.SaveAs c00 & n & ".xls", xlExcel8
          .Parent.Close 0
        End With
        ThisWorkbook.Sheets("DATATOTAAL").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Resize(UBound(ar)).Value = ar
      End If
    Next n
  End If
End Sub
 
Super Dank

Beste Cow17 & VeNA,
Super dank. Het programmaatje werkt als een tierelier. Ik ben er blij mee.

Nog een klein dingetje. Het uiteindelijke excel document is goed, maar de tussendoor opgeslagen document neemt het programma een aparte regel voor de grootheid van de parameter vanaf de 5e; zie bijlage.
Kan dit ook veranderd worden zoals dat bij de eerste 5 parameters? Is dan de oplossing om de hele array (131!) te omschrijven? Dit past waarschijnlijk niet in de Macro dus moet dan opgesplitst worden?!
Nogmaals dank voor jullie snelle en super bijdrage
Groet Maarten
 

Bijlagen

  • Hardloper1.xls
    555 KB · Weergaven: 27
Werk eens uit wat je wilt bereiken. Wat staat waar? Welke waarden zijn wat? Welke wil je uiteindelijk zien. Volgens mij klopt van jouw voorbeeld code of het resultaat niet veel. 131 elementen in een array is helemaal niets.

Edit. In jouw code verwijder je alleen de kolomkoppen en niet de kolommen. Vandaar dat er niets van de resultaten klopt. Nu met 131 elementen incluis kolomkop. Waarom je in de tab 'DATATOTAAL' er 174 hebt zal wel een logica hebben die ik niet zie.
Code: 
Sub VenA()
  c00 = "E:\Temp\Hardloper"
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  t = Application.InputBox("Voor hoeveel hardlopers wil je de gegevens van bewerken?", , , , , , , 1)
  
  If IsNumeric(t) Then
    For n = 1 To t
      If Dir(c00 & n & ".csv") <> "" Then
        With Workbooks.Open(c00 & n & ".csv").Sheets(1)
          ar = .Cells(1).CurrentRegion
          ReDim ar1(1, 0)
          ar1(0, 0) = "Parameter/hardloper"
          ar1(1, 0) = "Hardloper" & n
          For j = 2 To UBound(ar, 2) Step 2
            ReDim Preserve ar1(1, UBound(ar1, 2) + 1)
            ar1(0, UBound(ar1, 2)) = ar(1, j) & "(" & Trim(ar(1, j + 1)) & ")"
            ar1(1, UBound(ar1, 2)) = ar(2, j + 1)
          Next j
          .Rows("1:2").Delete
          .Cells(1).Resize(UBound(ar1, 2), 2) = Application.Transpose(ar1)
          With .Cells(1).CurrentRegion
            .Columns(1).Font.Bold = True
            .Font.Name = "Calibri"
            .Font.Size = 14
            .Columns.AutoFit
            ar = .Columns(2)
          End With
          .Parent.SaveAs c00 & n & ".xls", xlExcel8
          .Parent.Close 0
        End With
        ThisWorkbook.Sheets("DATATOTAAL").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Resize(UBound(ar)).Value = ar
      End If
    Next n
  End If
End Sub
 
Laatst bewerkt:
VeNa, dank voor je snelle reactie en sorry dat ik niet duidelijk ben.

Ik wil eigenlijk twee excel bestanden vanuit het cvs-bestand:
1) excel bestand met per hardloper met 2 kolommen (Kolom A: de variabele en Kolom B: de waarde hiervan).
Als ik het cvs bestand inlees in excel maakt hij er twee rijen van met de eerste rij de variabele, maar helaas is hierbij de variabele gesplitst in 2 cellen (de eerste de naam van de variabele en de tweede cel in de rij de grootheid van deze variabele). Ik wil dus deze twee cellen samenvoegen (variabele + grootheid in een cel), behalve voor de eerst cel (deze bevat "type") en dit moet dan "parameters" worden.
De tweede rij is goed en hoeft alleen de eerste cel veranderd te worden van "type" naar "hardloper..".
En dan moet alles gedraaid worden zodat het in kolommen komt te staan in plaats van rijen.

Omdat in jouw laatste versie van de Macro de eerste 5 variabele gedefineerd waren (achter array) kwamen deze goed in het excel te staan, maar de latere variabele dus niet: verschillende rij variabele en grootheid.
Mijn vraag is of het dus mogelijk is om de cellen te combineren of dat ik alle 131 variabele in moet vullen als "array". Ik heb het nu gedaan voor 8 variabele: zie bijlage.

2) Het andere excel document (het belangrijkste) wat ik graag wil hebben is het overzichtstabel met de verschillende hardlopers in de verschillende kolommen en met kolom 1(er zelf ingezet) de variabele met de parameters. Dit gaat aan de hand van jouw macro dus super goed en snel!! Zie tabblad DATATOTAAL met een voorbeeld zoals ik die heb laten "lopen" met 3 cvs-bestanden.

Ik hoop dat het probleem zo duidelijk is en wat ik graag zou willen. Misschien is het nog wel handiger om de gegevens voor het Excel bestand per Hardloper te genereren uit het tabblad DATATOTAAL. Als dat efficiënter is ga ik dat proberen. Moet denk ik lukken met jullie handvatten.
Nogmaals dank voor de hulp en fijne avond.

Groet Maarten
 

Bijlagen

  • DATA Totaal.xlsm
    34,4 KB · Weergaven: 22
Ik had mijn bericht net aangepast. Dus kijk eerst even of het nu wel werkt.
 
er gebeurt iets door de presentatie van de data, het splitsen naar kolommen gebeurt verkeerd omdat er daar toevallig nog een extra komma staat op ", N,", dus zou die vermeden moeten worden voor de 1e rij.
Eigenlijk op zich eerder een ongemak dan een onoverkomelijk probleem.
Code: 
Sub Hardloper()

    fileName = ThisWorkbook.Path & "\hardloper2.csv"
    fileNo = FreeFile

    Open fileName For Input As #fileNo
    hardloperData = Split(Input$(LOF(fileNo), fileNo), vbLf) 'inlezen csv-file en split op vblf
    hardloperData(0) = Replace(hardloperData(0), ", N,", "_N,") 'hinderlijke ", N," aanpakken
    Close #fileNo
    
    ActiveSheet.UsedRange.ClearContents
    For i = 0 To UBound(hardloperData) - 1 'rijen aflopen
        arr = Split(hardloperData(i), ",") 'splitten op ","
        Range("A1").Offset(, i).Resize(UBound(arr) + 1).Value = Application.Transpose(arr) 'wegschrijven
    Next

End Sub

ik wacht even af, ik kan niet inschatten of de juiste gegevens nu tov elkaar komen te staan.
 
Laatst bewerkt:
Beste Cow18,
Dit is 'm hoor! Helemaal top.
De macro pakte 'm alleen voor de "N" en ik heb 'm aangepast voor de andere variabele met parameters (misschien kan dit nog efficiënter, maar zo werkt het goed.

Echter alleen bij N/cm2 gaat het nog niet goed: dat blijft een aparte regel, ondanks het commando. Op de een of andere manier "ziet" excel dit niet. In tabblad "hardloper" in rij 97 zie je dat het nog mis gaat. Moet ik wat speciaal hier aan toevoegen om ook deze waarde in de rij erboven te krijgen?
Code: 
Sub Hardloper()

c00 = "/Users/mvdworp/Documents/Zebris/Onderzoek DATA Pilot/Hardloper"
Application.ScreenUpdating = False
Application.DisplayAlerts = False

  t = Application.InputBox("Voor hoeveel hardlopers wil je de gegevens van bewerken?", , , , , , , 1)
  If IsNumeric(t) Then
    For n = 1 To t
     
    FileName = c00 & n & "/parameters.csv"
     
    fileNo = FreeFile
    Open FileName For Input As #fileNo
    hardloperData = Split(Input$(LOF(fileNo), fileNo), vbLf)                                                   'inlezen csv-file en split op vblf
    hardloperData(0) = Replace(hardloperData(0), ", N,", " (N),")                                              'hinderlijke ", N," aanpakken
    hardloperData(0) = Replace(hardloperData(0), ", %,", " (%),")
    hardloperData(0) = Replace(hardloperData(0), ", graad,", " (graden),")
    hardloperData(0) = Replace(hardloperData(0), ", cm,", " (cm),")
    hardloperData(0) = Replace(hardloperData(0), ", sec,", " (sec),")
    hardloperData(0) = Replace(hardloperData(0), ", stappen/min,", " (stappen/min),")
    hardloperData(0) = Replace(hardloperData(0), ", km/h,", " (km/h),")
    hardloperData(0) = Replace(hardloperData(0), ", mm,", " (mm),")
    hardloperData(0) = Replace(hardloperData(0), ", cm/sec,", " (cm/sec),")
    hardloperData(0) = Replace(hardloperData(0), ",   N/cm²,", " (N/cm2),")
    hardloperData(0) = Replace(hardloperData(0), ", % van standfase,", " (% van standfase),")
    
    Close #fileNo
    
    ActiveSheet.UsedRange.ClearContents
    For i = 0 To UBound(hardloperData) - 1                                                                             'rijen aflopen
        arr = Split(hardloperData(i), ",")                                                                                      'splitten op ","
        Range("A1").Offset(, i).Resize(UBound(arr) + 1).Value = Application.Transpose(arr)        'wegschrijven
    Next
    
Next n
End If
End Sub/CODE]

Verder heb ik nog een vraag of je me wilt helpen bij het combineren van de twee macro's. Ik heb het zelf geprobeerd, met jullie macro's/commando's, maar gaat echt boven mij pet :evil:!
Ik wil dus de macro Hardloper in de macro "helemaalklaar" integreren zodat ik dus een apart excel bestand krijg per hardloper (twee kolommen: variabele en waarde) en dat de kolom gekopieerd wordt in de eerste vrij kolom van het tabblad "DATATOTAAL". Dit laatste gaat al goed (zie tabblad DATATOTAAL voor 4 hardlopers)
Bedankt vast weer. Groet Maarten
 

Bijlagen

  • DATA TotaalVersie2.xlsm
    38,1 KB · Weergaven: 22
PS. het verhoogt de leesbaarheid voor deze site als je vooraf even op het #-teken in het menu boven je antwoord klikt en dan je code daartussen plakt
Code: 
Sub Hardloper()

    c00 = "/Users/mvdworp/Documents/Zebris/Onderzoek DATA Pilot/Hardloper"
    c00 = ThisWorkbook.Path & "\hardloper"                           'enkel voor mij !!!
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    t = Application.InputBox("Voor hoeveel hardlopers wil je de gegevens van bewerken?", , , , , , , 1)
    If IsNumeric(t) Then
        For n = 1 To t

            FileName = c00 & n & "/parameters.csv"
            FileName = c00 & n & ".csv"                              'enkel voor mij

            fileNo = FreeFile
            Open FileName For Input As #fileNo
            hardloperData = Split(Trim(Input$(LOF(fileNo), fileNo)), vbLf)    'inlezen csv-file en split op vblf
            hardloperData(0) = Replace(hardloperData(0), ", N,", " (N),")    'hinderlijke ", N," aanpakken
            hardloperData(0) = Replace(hardloperData(0), ", %,", " (%),")
            hardloperData(0) = Replace(hardloperData(0), ", graad,", " (graden),")
            hardloperData(0) = Replace(hardloperData(0), ", cm,", " (cm),")
            hardloperData(0) = Replace(hardloperData(0), ", sec,", " (sec),")
            hardloperData(0) = Replace(hardloperData(0), ", stappen/min,", " (stappen/min),")
            hardloperData(0) = Replace(hardloperData(0), ", km/h,", " (km/h),")
            hardloperData(0) = Replace(hardloperData(0), ", mm,", " (mm),")
            hardloperData(0) = Replace(hardloperData(0), ", cm/sec,", " (cm/sec),")
            hardloperData(0) = Replace(hardloperData(0), ", N/cm²,", " (N/cm2),")    '---> bij mij 1 spatie minder !!!
            hardloperData(0) = Replace(hardloperData(0), ", % van standfase,", " (% van standfase),")

            Close #fileNo

            With Workbooks.Add.Sheets(1)
                For i = 0 To UBound(hardloperData) - 1               'rijen aflopen
                    arr = Split(Replace(hardloperData(i), Chr(13), ""), ",")    'splitten op "," en verwijderen van hinderlijke CR
                    .Range("A1").Offset(, i).Resize(UBound(arr) + 1).Value = Application.Transpose(arr)    'wegschrijven
                Next

                With .Cells(1).CurrentRegion
                    .Cells(1, 2) = "Hardloper" & n
                    .Font.Name = "Calibri"
                    .Font.Size = 14
                    .Columns.AutoFit
                End With
                .Parent.SaveAs c00 & n & "_parameters.xls", xlExcel8    '---> even weer aanpassen naar jouw voorkeur
                .Parent.Close 0
            End With

            With ThisWorkbook.Sheets("DATATOTAAL").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1)
                .Resize(UBound(arr) + 1).Value = Application.Transpose(arr)
                .Value = "hardloper" & n
                .EntireColumn.AutoFit
            End With

        Next n

    End If
End Sub
 
Laatst bewerkt:
Beste Cow18,
Super dank voor je snelle (re-)actie. En de volgende keer zal ik #toevoegen bij en code.
De macro doet het goed, alleen die N/cm2 pakt die nog niet :(. Je gaf als aantekening dat bij jouw een spatie meer!! werkte. Wat bedoel je daarmee en kan ik dat ook proberen of iets anders.
Nogmaals dank. Fijne avond. Groet Maarten
 
Hebben we het over dezelfde bestanden? Als ik de code in #16 draai obv de bestanden in #6 krijg ik als resultaat de bijgevoegde bestanden.
 

Bijlagen

  • Hardloper2.xls
    36 KB · Weergaven: 22
  • Hardloper1.xls
    36 KB · Weergaven: 21
#20

VeNa, ik heb het over de laatste Macro die Cow18 gemaakt heeft.
Wanneer ik deze nu laat "lopen" gaat alles naar wens, alleen de rijen 97 t/m 119 in het aparte excel-bestand (hardloper1.paremeters.xls) gaan niet goed ivm "N/cm2".
- Regel; hardloperData(0) = Replace(hardloperData(0), ", N/?cm?^2,", " (N/cm^2),").

Op de een of andere manier combineert hij de regels niet zoals bij de andere, bovenliggende, commando's. Ik heb inmiddels al aardig N/cm2 varianten geprobeerd maar helaas. Jij enig idee wat ik voor de "N/cm2" moet invullen zodat het commando (juist) uitgevoerd word?
Ik heb de laatste versie document met Macro bijgevoegd.
Bedankt vast weer voor de moeite. Groet Maarten
 

Bijlagen

  • DATA TotaalVersie3.xlsm
    29,3 KB · Weergaven: 26
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan