VBA-Programmierung in Microsoft Excel

Tutorial: Excel-Beispiele

Stunden tagesweise addieren

Gruppe

Funktion

Bereich

SUMMEWENN

Thema

Stunden tagesweise addieren

Problem

Aus der Stempelliste sollen die Stunden eines jeweiligen Tages addiert werden.

Lösung

Darstellung nur anhand einer Beispielarbeitsmappe möglich.




ClassModule: frmCode

Private Sub cboLaender_Change()
   If txtCode.TextLength = 11 Then
      Call txtCode_Change
   End If
End Sub

Private Sub cmdCancel_Click()
   Unload Me
End Sub

Private Sub cmdOK_Click()
   ActiveCell.Value = lblCode.Caption
   Unload Me
End Sub

Private Sub txtCode_Change()
   Dim wks As Worksheet
   Dim iChar As Integer, iCode As Integer
   Dim sCode As String, sTmp As String
   If txtCode.TextLength = 0 Then
      lblCode.Caption = ""
      Exit Sub
   End If
   If Right(txtCode.Text, 1) Like "[0-9]" = False Then
      txtCode.Text = Left(txtCode.Text, Len(txtCode.Text) - 1)
   End If
   Set wks = ThisWorkbook.Worksheets("Länder")
   If txtCode.TextLength = 11 Then
      sCode = wks.Cells(cboLaender.ListIndex + 1, 3).Value
      sCode = sCode & txtCode.Text
      For iChar = 14 To 1 Step -2
         iCode = iCode + CInt(Mid(sCode, iChar, 1))
      Next iChar
      iCode = iCode * 3
      For iChar = 13 To 1 Step -2
         iCode = iCode + CInt(Mid(sCode, iChar, 1))
      Next iChar
      iCode = Fix(iCode / 10) * 10 + 10 - iCode
      sTmp = wks.Cells(cboLaender.ListIndex + 1, 2).Value & _
         " " & Mid(sCode, 4, 3) & "." & _
         Mid(sCode, 7, 4) & "." & _
         Mid(sCode, 11, 4) & "." & iCode
      If Right(sTmp, 2) = "10" Then
         sTmp = Left(sTmp, Len(sTmp) - 2) & "0"
      End If
      iCode = InStr(sTmp, " ") + 1
      Do Until Mid(sTmp, iCode, 1) <> "0"
         Mid(sTmp, iCode, 1) = "µ"
         iCode = iCode + 1
      Loop
      sTmp = WorksheetFunction.Substitute(sTmp, "µ", "")
      lblCode.Caption = sTmp
      cmdOK.SetFocus
   End If
End Sub

Private Sub UserForm_Initialize()
   cboLaender.List = ThisWorkbook.Worksheets("Länder") _
      .Range("A1").CurrentRegion.Columns(1).Value
   cboLaender.ListIndex = 0
End Sub

StandardModule: Modul1

Sub DialogAufruf()
   frmCode.Show
End Sub

    


Beiträge aus dem Excel-Forum zu den Themen Funktion und SUMMEWENN