Code:
'Function lookForName
'Determines if a customer's name is already found in the
'second (control) sheet; returns the row number if it is found
'else the negative number of the last row
'The Function terminates if it finds two empty lines
Private Function lookForName(cName As String) As Integer
Dim colNum, rowNum As Integer
Dim custName As String
colNum = 1 'The column where the names are stored
rowNum = 4 'The row to start in
Do
custName = Worksheets("Kontrolle").Cells(rowNum, colNum).Value
If (custName = cName) Then
lookForName = rowNum
Exit Function
End If
rowNum = rowNum + 1
'the next line is to be sure that the function only terminates after
'two empty lines
If (custName = "") Then custName = Worksheets("Kontrolle").Cells(rowNum, colNum).Value
Loop Until custName = ""
lookForName = (rowNum - 1) * -1
End Function
'Sub CountHoursByCustomer()
'Count the hours for every customer
'This is done in three loops. The first iterates over all weekdays, the second
' one over all employees, the third over all hours.
Sub CountHoursByCustomer()
Dim name, temp, wday As String 'name of the customer, temp, day of week
Dim wTime As Single 'The worktime
Dim i, currentCol As Integer 'count variables
Dim colStart, rowStart, nextCol, timeCol, targetRow As Integer
Dim nextDayCol, wdayCol, wdayRow, rowsPerDay, emptyRows As Integer
'begin of configuration
colStart = 4 'start value for colums (=D)
rowStart = 4 'start value for rows (=4)
nextCol = 3 'the distance to the next column
timeCol = -1 'the position of the Column where the time is stored
' relative to the customers name
nextControlCol = 4 'Distance to the next column in the check sheet.
startControlCol = 3 ' The first column in the control sheet (=C)
wdayCol = 1 'The column in which the weekdays are found (=A)
rowsPerDay = 12 'The number of rows each day has
emptyRows = 2 'The number of empty rows between the weekdays
'end of configuration
wdayRow = rowStart
currentControlCol = startControlCol
'First loop: loop over all weekdays
Do
wday = Worksheets("Dienstplan").Cells(wdayRow, wdayCol).Value
If (wday <> "") Then
currentCol = colStart
'Second loop: loop over all employees
Do
i = wdayRow
'Third Loop: Loop over all hours
Do
name = Worksheets("Dienstplan").Cells(i, currentCol).Value
wTime = Worksheets("Dienstplan").Cells(i, currentCol + timeCol).Value
If (wTime > 0) Then
targetRow = lookForName((name))
If (targetRow > 0) Then 'Name already exists
Dim c As Object
Set c = Worksheets("Kontrolle").Cells(targetRow, currentControlCol)
c.Value = c.Value + wTime
Else 'Name not found--> create new cells
targetRow = targetRow * -1
Worksheets("Kontrolle").Cells(targetRow, 1).Value = name
Worksheets("Kontrolle").Cells(targetRow, currentControlCol).Value = wTime
End If
End If
i = i + 1
Loop Until i >= (rowsPerDay + wdayRow)
currentCol = currentCol + nextCol
i = wdayRow
name = Worksheets("Dienstplan").Cells(i, currentCol).Value
Loop Until name = ""
End If
wdayRow = wdayRow + rowsPerDay + emptyRows
currentControlCol = currentControlCol + nextControlCol
Loop Until wday = ""
End Sub
Das Programm funktioniert nur, wenn die Tage im selben Abstand sind d.h. jeder Tag ist 12 Zeilen lang, danach kommen zwei Leerzeilen (ist einstellbar indem du die Werte unter rowsPerDay und emptyRows änderst).
Sollte funktionieren, wenn was nicht geht oder du eine genauere Erklärung brauchst einfach posten.
<edit>
Das "Mitdenken" von Excel kann man vielleicht einfach verhindern indem man die Zellen schützt.
Btw.: Wielange hast du eigentlich für diese Überprüfung gebraucht? Die WENN Konstrukte sehen ziemlich kompliziert aus
</edit>
Jak
____________________________________
Join the DNRC |
Godwin\'s Law (thx@stona)
Documentation is like sex: If it\'s good, it\'s very, very good. If it\'s bad, it\'s better than nothing.
\"In theory, theory and practice are the same. In practice, they are not\" (Lawrence Berra)