Typen unverträglich
02.10.2008 12:34:00
Gordon
heute nehme ich euch mal wieder viel zu stark in Anspruch, aber ich brauche nun nochmal ein geschultes Auge. Ich habe hier zugegebenermaßen einen etwas unüberscihtlichen Code. Wenn ich ihn ausführe kommt die Meldung "Typen unverträglich".
Sieht vielleicht jemand, wo es hapen könnte? Denn ich sehe es gerade nicht.... :(
Sub Test()
Dim Betrag As Integer
Dim Nr As Integer
Dim Zeile As Long
Dim Monat As Integer
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim x As Integer
Dim y As Integer
Dim Kst As Integer
Application.DisplayAlerts = False
Application.EnableEvents = False
y = 11
Set NeueDatei = Workbooks.Open(ThisWorkbook.Path & "\" & "Pub3.1.1.KST0801-12KN - AP.xls", , _
True)
'Korrektur Pub IST
With ThisWorkbook.Sheets("Test")
.Range("Z11:AZ12").ClearContents
.Range("Z15:AZ18").ClearContents
.Range("Z21:AZ31").ClearContents
.Range("Z36:AZ40").ClearContents
End With
With NeueDatei.Sheets("Kost")
For Zeile = 10 To 25000
If .Range("T" & Zeile).Value = "#" Then
For a = 3 To 14
If .Cells(Zeile, a).Value 0 Then
Monat = a + 23
Betrag = .Cells(Zeile, a).Value
b = 1
Do
If Len(.Cells(Zeile - b, 1).Value) > 4 Then
Nr = Left(.Cells(Zeile - b, 1).Value, 2) * 1
Exit Do
Else
b = b + 1
End If
Loop
For c = 11 To 45
If ThisWorkbook.Sheets("Test").Cells(c, 7).Value = Nr Then
ThisWorkbook.Sheets("Test").Cells(c, Monat).Value = ThisWorkbook. _
Sheets("Test").Cells(c, Monat).Value + (Betrag * -1)
Exit For
End If
Next c
End If
Next a
End If
Next Zeile
For g = 26 To 52
ThisWorkbook.Sheets("Test").Cells(11, g).Value = ThisWorkbook.Sheets("Test").Cells(11, _
_
_
g).Value * -1
ThisWorkbook.Sheets("Test").Cells(12, g).Value = ThisWorkbook.Sheets("Test").Cells(12, _
_
_
g).Value * -1
Next g
'Übertrag Pub IST
For x = 425 To 25000
If Left(.Cells(x, 1).Value, 7) = "Hinweis" And Left(.Cells(x + 2, 1).Value, 4) * 1 Mod _
_
_
1000 0 Then
Kst = Left(.Cells(x + 2, 1).Value, 4)
'Kostenstelle erstellen
Do
If ThisWorkbook.Sheets("Test").Cells(y, 2).Value "" Then
y = y + 1
ElseIf ThisWorkbook.Sheets("Test").Cells(y, 2).Value = "" Then
y = y + 3
ThisWorkbook.Sheets("Test").Range("B" & y & ":" & "AZ" & y + 35).xlFormats = _
_
_
ThisWorkbook.Sheets("Format").Range("B11:AZ46").xlFormats
ThisWorkbook.Sheets("Test").Range("B" & y & ":" & "AZ" & y + 35).xlFormulas _
_
_
= ThisWorkbook.Sheets("Format").Range("B11:AZ46").xlFormulas
ThisWorkbook.Sheets("Test").Range("G" & y & ":" & "H" & y + 35).Value = _
ThisWorkbook.Sheets("Format").Range("G11:H46").Value
ThisWorkbook.Sheets("Test").Range("B" & y & ":" & "B" & y + 35) = "publ"
ThisWorkbook.Sheets("Test").Range("C" & y & ":" & "C" & y + 35) = Kst
ThisWorkbook.Sheets("Test").Range("D" & y & ":" & "D" & y + 35) = "Träger"
ThisWorkbook.Sheets("Test").Range("E" & y & ":" & "E" & y + 35) = Right( _
Left(.Cells(x + 2, 1).Value, 7), Len(Left(.Cells(x + 2, 1).Value, 7)) - 6)
End If
Loop Until ThisWorkbook.Sheets("Test").Cells(y, 2).Value = ""
Zeile = x + 1
Do
If Left(.Cells(Zeile, 1).Value, 8) "Hinweis:" Then
Zeile = Zeile + 1
End If
Loop Until Left(.Cells(Zeile, 1).Value, 8) = "Hinweis:"
'Summe
Do
Select Case Left(.Cells(x, 1).Value, 5)
Case "1.a) ", "2.a) ", "3.a) ", "4.a) ", "5.a) ", "6.a) ", "7.a) ", "8.a) ", _
_
_
"9.a) ", "10.a)", "11.a)", "12.a)", "13.a)", "14.a)", "15.a)", "16.a)", "17.a)", "18.a)", "19. _
_
a)", "20.a)", "21.a)", "22.a)"
Do
If .Cells(x, 1).Value " = Summe" Then
x = x + 1
End If
Loop Until .Cells(x, 1).Value " = Summe"
End Select
Select Case Left(.Cells(x, 1).Value, 5)
Case "1.a) ": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y, 23 + c).Value = _
ThisWorkbook.Sheets("Test").Cells(y, 23 + c).Value + .Cells(x, c).Value
Next c
Case "2.a) ": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 1, 23 + c).Value = _
_
_
ThisWorkbook.Sheets("Test").Cells(y + 1, 23 + c).Value + .Cells(x, c).Value
Next c
Case "3.a) ": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 4, 23 + c).Value = _
_
_
ThisWorkbook.Sheets("Test").Cells(y + 4, 23 + c).Value + .Cells(x, c).Value
Next c
Case "4.a) ": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 5, 23 + c).Value = _
_
_
ThisWorkbook.Sheets("Test").Cells(y + 5, 23 + c).Value + .Cells(x, c).Value
Next c
Case "5.a) ": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 6, 23 + c).Value = _
_
_
ThisWorkbook.Sheets("Test").Cells(y + 6, 23 + c).Value + .Cells(x, c).Value
Next c
Case "6.a) ": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 7, 23 + c).Value = _
_
_
ThisWorkbook.Sheets("Test").Cells(y + 7, 23 + c).Value + .Cells(x, c).Value
Next c
Case "7.a) ": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 10, 23 + c).Value _
_
_
= ThisWorkbook.Sheets("Test").Cells(y + 10, 23 + c).Value + .Cells(x, c).Value
Next c
Case "8.a) ": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 11, 23 + c).Value _
_
_
= ThisWorkbook.Sheets("Test").Cells(y + 11, 23 + c).Value + .Cells(x, c).Value
Next c
Case "9.a) ": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 12, 23 + c).Value _
_
_
= ThisWorkbook.Sheets("Test").Cells(y + 12, 23 + c).Value + .Cells(x, c).Value
Next c
Case "10.a)": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 13, 23 + c).Value _
_
_
= ThisWorkbook.Sheets("Test").Cells(y + 13, 23 + c).Value + .Cells(x, c).Value
Next c
Case "11.a)": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 14, 23 + c).Value _
_
_
= ThisWorkbook.Sheets("Test").Cells(y + 14, 23 + c).Value + .Cells(x, c).Value
Next c
Case "12.a)": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 15, 23 + c).Value _
_
_
= ThisWorkbook.Sheets("Test").Cells(y + 15, 23 + c).Value + .Cells(x, c).Value
Next c
Case "13.a)": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 16, 23 + c).Value _
_
_
= ThisWorkbook.Sheets("Test").Cells(y + 16, 23 + c).Value + .Cells(x, c).Value
Next c
Case "14.a)": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 17, 23 + c).Value _
_
_
= ThisWorkbook.Sheets("Test").Cells(y + 17, 23 + c).Value + .Cells(x, c).Value
Next c
Case "15.a)": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 18, 23 + c).Value _
_
_
= ThisWorkbook.Sheets("Test").Cells(y + 18, 23 + c).Value + .Cells(x, c).Value
Next c
Case "16.a)": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 19, 23 + c).Value _
_
_
= ThisWorkbook.Sheets("Test").Cells(y + 19, 23 + c).Value + .Cells(x, c).Value
Next c
Case "17.a)": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 20, 23 + c).Value _
_
_
= ThisWorkbook.Sheets("Test").Cells(y + 20, 23 + c).Value + .Cells(x, c).Value
Next c
Case "18.a)": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 25, 23 + c).Value _
_
_
= ThisWorkbook.Sheets("Test").Cells(y + 25, 23 + c).Value + .Cells(x, c).Value
Next c
Case "19.a)": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 26, 23 + c).Value _
_
_
= ThisWorkbook.Sheets("Test").Cells(y + 26, 23 + c).Value + .Cells(x, c).Value
Next c
Case "20.a)": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 27, 23 + c).Value _
_
_
= ThisWorkbook.Sheets("Test").Cells(y + 27, 23 + c).Value + .Cells(x, c).Value
Next c
Case "21.a)": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 28, 23 + c).Value _
_
_
= ThisWorkbook.Sheets("Test").Cells(y + 28, 23 + c).Value + .Cells(x, c).Value
Next c
Case "22.a)": For c = 3 To 14
ThisWorkbook.Sheets("Test").Cells(y + 29, 23 + c).Value _
_
_
= ThisWorkbook.Sheets("Test").Cells(y + 29, 23 + c).Value + .Cells(x, c).Value
Next c
End Select
x = x + 1
Loop Until Left(.Cells(x, 1).Value, 8) = "Hinweis:"
End If
Next x
End With
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub