• 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 automatisch in rijen plaatsen ipv kolommen

Status
Niet open voor verdere reacties.

MvdWorp

Gebruiker
Lid geworden
11 jun 2013
Berichten
27
Beste Helpmij.nl helpers,

Paar maanden terug heb ik, met héél veel hulp van Cow18 & Vena (waarvoor nogmaals dank), een macro gemaakt die ervoor zorgt dat .CVS-bestanden worden ingelezen, aangepast, opgeslagen in xls-bestand en de data gekopieerd worden in het openstaande excel-bestand. Dit proces wordt herhaald voor het aantal hardlopers die getest zijn.
Alles wordt nu in kolommen gezet, maar ik wil het graag in rijen omdat ik dan makkelijker andere berekeningen met deze data kan uitvoeren!

Ik heb al zitten proberen met dingen te veranderen, weg te laten etc. maar het lukt me niet. Kan iemand me helpen?
Bedankt vast voor de moeite,

Groet Maarten

Huidige code:
Code:
Sub HardloperDEF()

    c00 = "/Users/mvdworp/Documents/Zebris/Onderzoek/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(Trim(Input$(LOF(fileNo), fileNo)), vbLf)
            hardloperData(0) = Replace(hardloperData(0), ", N,", " (N),")
            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" & Chr(194) & Chr(178) & ",", " (N/cm" & Chr(178) & "),")
            hardloperData(0) = Replace(hardloperData(0), ", % van standfase,", " (% van standfase),")

            Close #fileNo

            With Workbooks.Add.Sheets(1)
                For i = 0 To UBound(hardloperData) - 1
                    arr = Split(Replace(hardloperData(i), Chr(13), ""), ",")
                    .Range("A1").Offset(, i).Resize(UBound(arr) + 1).Value = Application.Transpose(arr)
                Next
                
                With .Cells(1).CurrentRegion
                    .Cells(1, 2) = "Hardloper" & n
                    .Cells(1.1) = "Parameters"
                    .Font.Name = "Calibri"
                    .Font.Size = 14
                    .Columns.AutoFit
                End With

                With .Rows(1)
                     .Font.Bold = True
                End With
                
                With .Range("A132")
                        .Delete Shift:=xlUp
                End With
            
                .Parent.SaveAs c00 & n & "/parameters.xls", xlExcel8
                .Parent.Close 0
            End With

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

        Next n
    End If
End Sub


P.s.: Ik heb een cvs-bestand bijgevoegd en het excel-bestand met macro en tabblad DATATOTAAL
 

Bijlagen

  • DATA TOTAAL Wijzigen 23 maart.xlsm
    35,3 KB · Weergaven: 24
  • Parameters.csv
    4,7 KB · Weergaven: 19
probeer dit eens:

Code:
Sub HardloperDEF()

    c00 = "/Users/mvdworp/Documents/Zebris/Onderzoek/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(Trim(Input$(LOF(fileNo), fileNo)), vbLf)
            hardloperData(0) = Replace(hardloperData(0), ", N,", " (N),")
            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" & Chr(194) & Chr(178) & ",", " (N/cm" & Chr(178) & "),")
            hardloperData(0) = Replace(hardloperData(0), ", % van standfase,", " (% van standfase),")

            Close #fileNo

            With Workbooks.Add.Sheets(1)
                For i = 0 To UBound(hardloperData) - 1
                    arr = Split(Replace(hardloperData(i), Chr(13), ""), ",")
                    .Range("A1").Offset(, i).Resize(UBound(arr) + 1).Value = Application.Transpose(arr)
                Next
                
                With .Cells(1).CurrentRegion
                    .Cells(1, 2) = "Hardloper" & n
                    .Cells(1.1) = "Parameters"
                    .Font.Name = "Calibri"
                    .Font.Size = 14
                    .Columns.AutoFit
                End With

                With .Rows(1)
                     .Font.Bold = True
                End With
                
                With .Range("A132")
                        .Delete Shift:=xlUp
                End With
            
                .Parent.SaveAs c00 & n & "/parameters.xls", xlExcel8
                .Parent.Close 0
            End With
            With ThisWorkbook.Sheets("DATATOTAAL").Cells(Rows.Count, 1).End(xlUp).Offset(1)
                    With .Columns(1)
                      .Font.Bold = True
                    End With
                    
                .Resize(, UBound(arr) + 1).Value = arr
                .Value = "hardloper" & n
                .EntireColumn.AutoFit
            End With
            
        Next n
    End If
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan