Einzelnen Beitrag anzeigen
Alt 04.03.2005, 18:37   #7
jak
Inventar
 
Registriert seit: 13.06.2001
Beiträge: 1.830


Standard

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)
jak ist offline   Mit Zitat antworten