Hallo Zusammen !
Ich arbeite momentan an meiner Bachelorarbeit, bei welcher ich Messungen durchführe.
Dementsprechend kommen einige Daten zusammen (Pro Proband 4 gemessene Muskeln mit jeweils 100 Daten)
Um diese in mein Statistik Programm zu übertragen, wurde mir eine Excel Datei mit Makro zur Verfügung gestellt.
Das Makro soll jeweils die Spalten mit den 100 Daten von den einzelnen Dateien der Probanden zu Zeilen in einer neuen Datei sammeln.
Also von Proband 001-028 sollen die 100 Daten des Muskels "VMO" in eine neue Datei eingefügt werden, wo dann jeweils eine Zeile den Namen des Probanden und dann die 100 Daten anzeigt.
Hoffe dass das so halbwegs verständlich ist :D
Die Daten sind jeweils von 20-119 in den 4 verschiedenen Spalten(passend zu den Muskeln) angegeben.
Wenn ich das Makro nach Anleitung ausprobiere, wird mir jedoch die Fehlermeldung "Laufzeitfehler '9': Index außerhalb des gültigen Bereichs" angezeigt.
Wenn ich auf "Debuggen" gehe, wird mir folgende Zeile angezeigt: arrWerte(r - 19, c) = Cells(r, Spalte)
Ich habe absolut keine Ahnung von Makros, deshalb hoffe ich, dass ihr mir weiterhelfen könnt, damit ich nicht alles von Hand übertragen muss.
Wenn ihr weitere Infos braucht sagt bescheid, danke schonmal für eure Antworten :)
Hier der ganze Code:
Dim ZielWB As String
Dim WBx As String
Dim nWB As Integer
Dim xName As String
Dim arrWerte(100, 60)
Sub Ergebnisanalyse_Main()
DatenLesen
DatenSchreiben
End Sub
Private Sub DatenLesen()
Dim x As Integer
Dim Spalte As Integer
ZielWB = ThisWorkbook.Name
nWB = Application.Workbooks.Count
Spalte = InputBox("Welche Spalte soll eingelesen werden? ", "Spalte", 3)
For c = 1 To 60
arrWerte(0, c) = "P" & Right("0" & c, 2)
Next c
For x = 1 To nWB
WBx = Workbooks(x).Name
If (WBx <> ZielWB) Then
If (Windows(Workbooks(x).Name).Visible = True) Then
Windows(WBx).Activate
xName = Cells(2, 2)
For c = 1 To 60
If (arrWerte(0, c) = xName) Then Exit For
Next c
For r = 20 To 119
arrWerte(r - 19, c) = Cells(r, Spalte)
Next r
Else
' Debug.Print Workbooks(x).Name
End If
End If
Next x
End Sub
Private Sub DatenSchreiben()
Windows(ZielWB).Activate
For c = 0 To 100
For r = 1 To 60
Cells(r, c + 1) = arrWerte(c, r)
Next r
Next c
End Sub
|