AW: "Fehler beim Kompilieren" (luschi)
09.03.2006 21:47:00
chris
Hallo selo, weiss zwar nicht ganz was dein Code machen soll.
Aber so kommt zumindest kein Fehler. Hilft dir das weiter ?
Sub beRechnung()
'first trying by Luschi
Dim wb As Workbook, _
ws1 As Worksheet, ws2 As Worksheet, _
rg1 As Range, rg2 As Range, _
loLetzte As Long, loI As Long, _
nArt As Integer, n1 As Long, n2 As Long, _
v As Variant, _
xlApp As Application
Set xlApp = Application
xlApp.ScreenUpdating = False
xlApp.Calculation = xlCalculationManual
xlApp.EnableEvents = False
Set wb = ThisWorkbook
Set ws1 = wb.Worksheets("gesamtplanung")
Set ws2 = wb.Worksheets("Arbeitstage")
ws1.Activate
loLetzte = IIf(IsEmpty(ws1.Cells(ws1.Rows.Count, 2)), _
ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row, ws1.Rows.Count)
For loI = 2 To loLetzte
If (ws2.Range("J7") Or ws2.Range("K7")) Then
Set rg1 = ws1.Range("C" & loI)
Set rg2 = ws1.Range("D" & loI)
If ws2.Range("J7") Then
nArt = 1
Set rg3 = wb.Names("funftagewochenamen").RefersToRange
Else
nArt = 2
Set rg3 = wb.Names("sechstagewochenamen").RefersToRange
End If
Else
nArt = 2
Set rg3 = ws1.Range("O" & loI)
End If
Select Case nArt
Case 1: n1 = ATC1(rg1.Value, rg2.Value, rg3)
Case 2: n1 = ATC(rg1.Value, rg2.Value, rg3)
Case 3: v1 = rg3.Value
End Select
If nArt <= 2 Then
ws1.Cells(loI, 14).Value = n1
Else
ws1.Cells(loI, 14).Value = v1
End If
ws1.Cells(loI, 14).NumberFormat = "General"
ws1.Range(Cells(loI, 14), Cells(loI, 15)).HorizontalAlignment = xlCenter
ws1.Range(Cells(loI, 14), Cells(loI, 15)).Font.ColorIndex = 3
Set rg1 = Nothing
Set rg2 = Nothing
Set rg3 = Nothing
Next loI
'wb.Worksheets("tabelle3").Activate
Set ws1 = Nothing
Set ws2 = Nothing
Set wb = Nothing
xlApp.Calculation = xlCalculationAutomatic
xlApp.EnableEvents = True
xlApp.ScreenUpdating = True
Set xlApp = Nothing
End Sub
Function ATC1(start As Date, Ende As Date, ByVal FT As Range)
Dim C As Range, xZahl As Integer, j As Date, k As Long
xZahl = 0
For j = start To Ende
If (Weekday(j) <> 1) And (Weekday(j) <> 7) Then
xZahl = xZahl + 1
End If
Next
For k = 1 To FT.Rows.Count
Set C = FT.Cells(k, 1)
If C.Value >= start And C.Value <= Ende Then
If (Weekday(C.Value) <> 1) And (Weekday(C.Value) <> 7) Then
xZahl = xZahl - 1
End If
End If
Next j
Set C = Nothing
ATC1 = xZahl
End Function
Function ATC(start As Date, Ende As Date, ByVal FT As Range)
Dim C As Range, _
a%, b%, i%, xZahl As Integer
a = 8 - Weekday(start)
b = Weekday(Ende) - 1
xZahl = (Ende - start) - (a + b)
xZahl = xZahl - (xZahl / 7)
xZahl = xZahl + a + b
If Weekday(start) = 1 Then
xZahl = xZahl - 1
End If
For i = 1 To FT.Rows.Count
Set C = FT.Cells(i, 1)
If C.Value >= start And C.Value <= Ende Then
If Weekday(C.Value) <> 1 Then
xZahl = xZahl - 1
End If
End If
Next i
Set C = Nothing
ATC = xZahl
End Function