Hilfe bei Makroprogrammierung
Sylvia
habe mich nun zum ersten Mal mit Makros beschäftigt und bin auch schon recht gut voran gekommen. An einer Stelle komme ich allerdings absolut nicht weiter und möchte Euch daher, um Hilfe bitten. Sorry, dass es soviel ist...
Es geht darum Daten aus einem Excel-Fragebogen in eine Excel-Datei zu importieren. Hier das _ Makro:
Sub LoadAll()
On Error Resume Next
Bla = Application.GetOpenFilename("Fragebogen (*.xls),*.xls", , "Studie", , True)
If Bla False Then
'On Error GoTo 0
' und los
Dim v, w, x, y, z As Integer
Dim ImpDat, Master As String
Master = ActiveWorkbook.Name
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Stat.Show (0)
For x = 1 To UBound(Bla)
Stat.Was.Caption = "Importiere " & x & " von " & UBound(Bla) & " ausgewählten."
Stat.Repaint
Workbooks.Open Filename:=Bla(x)
ImpDat = ActiveWorkbook.Name
y = 1
'Letzte Zeile suchen
w = 0
Do While Not Workbooks(Master).Sheets("VV").Range("A" & w + 4).Value = ""
w = w + 1
Loop
'1.7
z = 0
For z = 0 To 1
y = 0
For y = 0 To 3
If Sheets("Fragebogen").Range("E7").Offset(0, y * 3).Value = "x" Then
If Workbooks(Master).Sheets("VV").Range("A" & w + 4).Offset(0, z * 2).Value = "" _
Then
Workbooks(Master).Sheets("VV").Range("A" & w + 4).Offset(0, z * 2).Value = y + 1
Else
Workbooks(Master).Sheets("VV").Range("A" & w + 4).Offset(0, z * 2).Value = "F"
End If
End If
If Sheets("Fragebogen").Range("Q7").Offset(0, y * 3).Value = "x" Then
If Workbooks(Master).Sheets("VV").Range("B" & w + 4).Offset(0, z).Value = "" Then
Workbooks(Master).Sheets("VV").Range("B" & w + 4).Offset(0, z).Value = y + 1
Else
Workbooks(Master).Sheets("VV").Range("B" & w + 4).Offset(0, z).Value = "F"
End If
End If
Next y
Next z
z = 0
For z = 0 To 1
y = 0
For y = 0 To 3
If Sheets("Fragebogen").Range("E9").Offset(0, y * 3).Value = "x" Then
If Workbooks(Master).Sheets("VV").Range("C" & w + 4).Offset(0, z * 2).Value = "" _
Then
Workbooks(Master).Sheets("VV").Range("C" & w + 4).Offset(0, z * 2).Value = y + 1
Else
Workbooks(Master).Sheets("VV").Range("C" & w + 4).Offset(0, z * 2).Value = "F"
End If
End If
If Sheets("Fragebogen").Range("Q9").Offset(0, y * 3).Value = "x" Then
If Workbooks(Master).Sheets("VV").Range("D" & w + 4).Offset(0, z).Value = "" Then
Workbooks(Master).Sheets("VV").Range("D" & w + 4).Offset(0, z).Value = y + 1
Else
Workbooks(Master).Sheets("VV").Range("D" & w + 4).Offset(0, z).Value = "F"
End If
End If
Next y
Next z
z = 0
For z = 0 To 1
y = 0
For y = 0 To 3
If Sheets("Fragebogen").Range("E11").Offset(0, y * 3).Value = "x" Then
If Workbooks(Master).Sheets("VV").Range("E" & w + 4).Offset(0, z * 2).Value = "" _
Then
Workbooks(Master).Sheets("VV").Range("E" & w + 4).Offset(0, z * 2).Value = y + 1
Else
Workbooks(Master).Sheets("VV").Range("E" & w + 4).Offset(0, z * 2).Value = "F"
End If
End If
If Sheets("Fragebogen").Range("Q11").Offset(0, y * 3).Value = "x" Then
If Workbooks(Master).Sheets("VV").Range("F" & w + 4).Offset(0, z).Value = "" Then
Workbooks(Master).Sheets("VV").Range("F" & w + 4).Offset(0, z).Value = y + 1
Else
Workbooks(Master).Sheets("VV").Range("F" & w + 4).Offset(0, z).Value = "F"
End If
End If
Next y
Next z
z = 0
For z = 0 To 2
y = 0
For y = 0 To 3
If Sheets("Fragebogen").Range("E13").Offset(z, y * 3).Value = "x" Then
If Workbooks(Master).Sheets("VV").Range("G" & w + 4).Offset(0, z * 2).Value = "" _
Then
Workbooks(Master).Sheets("VV").Range("G" & w + 4).Offset(0, z * 2).Value = y + 1
Else
Workbooks(Master).Sheets("VV").Range("G" & w + 4).Offset(0, z * 2).Value = "F"
End If
End If
If Sheets("Fragebogen").Range("Q13").Offset(z, y * 3).Value = "x" Then
If Workbooks(Master).Sheets("VV").Range("H" & w + 4).Offset(0, z).Value = "" Then
Workbooks(Master).Sheets("VV").Range("H" & w + 4).Offset(0, z).Value = y + 1
Else
Workbooks(Master).Sheets("VV").Range("H" & w + 4).Offset(0, z).Value = "F"
End If
End If
Next y
Next z
z = 0
For z = 0 To 1
y = 0
For y = 0 To 3
If Sheets("Fragebogen").Range("E17").Offset(0, y * 3).Value = "x" Then
If Workbooks(Master).Sheets("VV").Range("M" & w + 4).Offset(0, z * 2).Value = "" _
Then
Workbooks(Master).Sheets("VV").Range("M" & w + 4).Offset(0, z * 2).Value = y + 1
Else
Workbooks(Master).Sheets("VV").Range("M" & w + 4).Offset(0, z * 2).Value = "F"
End If
End If
If Sheets("Fragebogen").Range("Q17").Offset(0, y * 3).Value = "x" Then
If Workbooks(Master).Sheets("VV").Range("N" & w + 4).Offset(0, z).Value = "" Then
Workbooks(Master).Sheets("VV").Range("N" & w + 4).Offset(0, z).Value = y + 1
Else
Workbooks(Master).Sheets("VV").Range("N" & w + 4).Offset(0, z).Value = "F"
End If
End If
Next y
Next z
z = 0
For z = 0 To 1
y = 0
For y = 0 To 3
If Sheets("Fragebogen").Range("E19").Offset(0, y * 3).Value = "x" Then
If Workbooks(Master).Sheets("VV").Range("O" & w + 4).Offset(0, z * 2).Value = "" _
Then
Workbooks(Master).Sheets("VV").Range("O" & w + 4).Offset(0, z * 2).Value = y + 1
Else
Workbooks(Master).Sheets("VV").Range("O" & w + 4).Offset(0, z * 2).Value = "F"
End If
End If
If Sheets("Fragebogen").Range("Q19").Offset(0, y * 3).Value = "x" Then
If Workbooks(Master).Sheets("VV").Range("P" & w + 4).Offset(0, z).Value = "" Then
Workbooks(Master).Sheets("VV").Range("P" & w + 4).Offset(0, z).Value = y + 1
Else
Workbooks(Master).Sheets("VV").Range("P" & w + 4).Offset(0, z).Value = "F"
End If
End If
Next y
Next z
Workbooks(Master).Sheets("VV").Range("Q" & w + 4).Value = Sheets("Fragebogen").Range("B23"). _
_
_
_
_
_
Value
'Abschluss
Workbooks(ImpDat).Close
Next x
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Stat.Hide
MsgBox UBound(Bla) & " Datensätze importiert"
End If
End Sub
Im Anhang sind sowohl der Fragebogen als auch die Test-Datei für den Import. Die "x" werden leider nicht richtig importiert. F heisst Fehler.
Weiss jemand von Euch einen Rat? Ich würde mich sehr über Tips freuen.
Schon mal ganz lieben Dank fürs Ansehen und viele Grüße,
Sylvia
https://www.herber.de/bbs/user/71442.xls
https://www.herber.de/bbs/user/71445.xlsm