Zeiterfassungsdaten auswerten

[Rabe]

Hallo,

leider war diese Woche zu viel los.

Die Kernzeit ist bei uns die Mindest-Anwesenheitszeit von 8:30 bis 15:15 Uhr.

Nochmals, erwarte nicht, dass ich dir einen kompletten Code liefere.

Ja, klar, erwarte ich nicht.

Das mit den 10 h hat mir gefallen. klappt gut.

Ich habe es für die Kernzeiten angepasst:

Code:

Sub Kernzeit_Beginn()
For i = 1 To Cells(Rows.Count, "V").End(xlUp).Row
    If IsDate(Cells(i, "V")) And IsDate(Cells(i, "Z")) Then
        'Kernzeit-Beginn: 8:30
        If (CDate(Cells(i, "V")) > 0.354166667) Then Cells(i, "V").Interior.Color = vbYellow: Debug.Print i
        ' 0.354166667 = 8,5 = 8:30 h
    End If
Next i
End Sub

Sub Kernzeit_Ende()
For i = 1 To Cells(Rows.Count, "Z").End(xlUp).Row
    If IsDate(Cells(i, "V")) And IsDate(Cells(i, "Z")) Then
        'Kernzeit-Ende: 15:15
        If (CDate(Cells(i, "Z")) < 0.63541625) Then Cells(i, "Z").Interior.Color = vbYellow: Debug.Print i
    End If
Next i
End Sub

---

ungeprüft ins Fenster geschrieben, Tipp- und LogikFehler wahrscheinlich

Ich habe das andere Makro so

Code:

Sub Test()
Dim Rng As Range
Dim adr As Variant
Dim ad1 As Variant

   With Columns(1)
      i = 1
      Set Rng = .Find("Musterfirma", , xlValues, xlWhole)
      If Not Rng Is Nothing Then
         adr = Rng.Address
         ad1 = Rng.Address
        
         Do
            Set Rng = .FindNext(Rng)
            Range(Range(ad1), Rng.Offset(-1)).Name = "Block" = i
            i = i + 1
         Loop Until Rng.Address = adr
      End If
   End With
End Sub

mal ausprobiert.

Es kam der"Fehler 1004, Anwendungs- oder objektorientierter Fehler" in der Zeile
Range(Range(ad1), Rng.Offset(-1)).Name = "Block" = i

Wenn ich das = zwischen "Block" und i durch & ersetze, kommt dieser Fehler ebenfalls.

Kannst Du das nochmal anschauen?

Gruß Ralf

[schauan]

Hallo Ralf,

2 Dinge:

1) das mit dem & ist perfekt
2) kann es sein, dass der Treffer vom Find in Zeile 1 ist? Dort geht der Offset(-1) nicht und bringt diese Fehlermeldung.

[Rabe]

Hi André,

ja, der erste Treffer ist in Zeile 1. Gut, dann ist das geklärt.
Dann werde ich auf einen anderen Suchbegriff gehen, der später kommt.

[später] ok, es kommt kein Fehler mehr und mit MsgBox (i) wird die 1 und die 2 angezeigt, da es ja 2 Blöcke sind.

Wie spreche ich die einzelnen Zeilen jedes Blockes an?
Wie kann ich die 4 Texte aus Spalte L und BC aus Zeile 1 und 2 jedes Blockes in Spalte BF-BI jeder Blockzeile schreiben?

[schauan]

Moin Ralf,

also, du nimmst als Bezug die Variable vom Bereich und sprichst darin z.B. die Zellen an

Hier mal ein kleines Beispiel zum Lernen

Sub test()
Dim rngBlock As Range
Set rngBlock = Range("B4:D7")
MsgBox rngBlock.Cells(2, 3).Address
MsgBox rngBlock.Columns(1).Address
MsgBox rngBlock.Rows(2).Address
End Sub

Im Bereich B4:D7 ist die Zelle 2,3 dann D5 - Auf dem Blatt wäre es ja C2
Analog dann mit Spalten und Zeilen ...

---

.. noch was,
also, rngBlock1.Cells(2, 3).Value = rngBlock2.Cells(2, 3).Value
würde dann den Wert aus rngBlock1 an die gleiche Stelle in rngBlock2 trnsferieren.

... und noch was.
adr und ad1 dürften immer den gleichen Inhalt haben. Ich habe nicht gesehen, dass Du die irgendwo veränderst. Es würde also eins von beiden reichen.

[Rabe]

Hi André,

das habe ich kapiert, da ist ja der Blockbereich durch die Vorgabe definiert.


Wie bekomme ich nun aus meiner Datei für das Blatt "Datum" die Zeilennummer der einzelnen Blöcke raus oder die Größe der Blöcke?

Hier steht in Zeile 4 und in Zeile 53 das "Organisationseinheit:". Die Blöcke gehen also von Zeile 4 bis 52 und von 53 bis "Ende der Tabelle".

Ich habe nun in die Beispieltabelle die 2 Blöcke nochmal eingefügt.

Also Block 1-Bereich:  4:52
Block 2-Bereich:  53:101
Block 3-Bereich:  102:150
Block 4-Bereich:  151:Ende der Tabelle

  Monatsjournal Blockbearbeitung.xlsb (Größe: 32,9 KB / Downloads: 2)

[Gast 123]

Hallo Ralf

ich habe mir nicht den ganzen Thread angesehen, vielleicht hilft dir dieser kleine Code weiter.  Mit Offet(+/-x, 0) kannst du den genauen Bereich eingrenzen den du brauchst. 
Die MsgBox zeigt dir sofort alle Ergebnise als gesamt Übersicht an. 

mfg Gast 123

Code:

Sub Blöcke_definieren()
   'Zeilenblöcke der Mitarbeiter definieren und Texte in Spalte BF:BI kopieren
   Dim Rng As Range
   Dim Adr1 As Variant   '1. Rng Adresse für Loop
   Dim AdX As Variant    'Anf Adresse (x)
   Dim EdX As Variant    'End Adresse (x)
   Dim gBer As Variant   'gesamt Bereich
   Dim i As Integer
  
   With Columns(1)
      i = 1
      Set Rng = .Find("Organisationseinheit:", , xlValues, xlWhole)
      If Not Rng Is Nothing Then
         Adr1 = Rng.Address
         gBer = Rng.Address
        
         Do
            If Right(gBer, 1) <> ":" Then
               gBer = gBer & ":"   'nur ":" anhaengen zum auswerten!
               i = i + 1
            Else
               'ADRESSEN kORREKTUR ÜBER OFFSET!
               AdX = Rng.Offset(0, 0).Address(0, 0)    'Anf Adresse Block
               EdX = Rng.Offset(-4, 0).Address(0, 0)   'End Adresse Block
               'End Adresse anhaengen!! Next Anf. Adresse laden
               gBer = gBer & EdX & vbLf & AdX
            End If
            Set Rng = .FindNext(Rng)
         Loop Until Rng.Address = Adr1
         'Last End Adresse laden  (xlup)
         EdX = Cells(Rows.Count, 1).End(xlUp).Address
         gBer = gBer & EdX
      End If
   End With
  
   MsgBox i & "  Blöcke" & vbLf & gBer
End Sub

[Steffl]

Hallo Ralf,

mein krückenhafter Vorschlag

Code:

ub Blöcke_definieren()
   'Zeilenblöcke der Mitarbeiter definieren und Texte in Spalte BF:BI kopieren
   Dim Rng As Range
   Dim adr As Variant
   Dim ad1 As Variant
   Dim Orga As String
   Dim MA As String
   Dim PersNr As String
   Dim AuswNr As String
   Dim Beginn As Long
   Dim Ende As Long
   Dim vntArray() As Variant
  
   With Columns(1)
      i = 1
      Set Rng = .Find("Organisationseinheit:", , xlValues, xlWhole)
      If Not Rng Is Nothing Then
         adr = Rng.Address
         ad1 = Rng.Address
        
         Do
            ad1 = Rng.Address
            ReDim Preserve vntArray(i - 1)
            vntArray(i - 1) = Rng.Row
            Set Rng = .FindNext(Rng)
            Range(Range(ad1), Rng.Offset(-1)).Name = "Block" & i
            
            MsgBox ("Beginn Block " & i & ": " & ad1)
            
'            Ende = Beginn - 1 'Beginn von Block 2
'
'            Orga = Range("L" & Beginn)
'            MA = Range("L" & Beginn + 1)
'            PersNr = Range("BC" & Beginn)
'            AuswNr = Range("BC" & Beginn + 1)
'
'            Range("BF" & Beginn & ":BF" & Ende).Value = Orga
'            Range("BG" & Beginn & ":BG" & Ende).Value = MA
'            Range("BH" & Beginn & ":BH" & Ende).Value = PersNr
'            Range("BI" & Beginn & ":BI" & Ende).Value = AuswNr
            
            i = i + 1
         Loop Until Rng.Address = adr
      End If
      ReDim Preserve vntArray(i - 1)
      vntArray(i - 1) = .Cells(.Rows.Count, 1).End(xlUp).Row + 4
   End With
      For i = 0 To UBound(vntArray) - 1
          MsgBox "Der Block " & i + 1 & " umfasst den Bereich " & Range(Cells(vntArray(i), 1), Cells(vntArray(i + 1) - 4, 5)).Address
      Next i
End Sub

[Rabe]

Hallo Gast 123 und Steffl,

vielen Dank für eure Vorschläge.

Ich habe beide ausprobiert und dann den von Steffl genommen, da in dem anderen die beiden mittleren Blöcke zusammengezogen wurden.

Mit dem Codevorschlag von André habe ich es dann auch geschafft, die Blöcke mit den Texten in den 4 Spalten auszufüllen.

Hier ist der Code:

Code:

Sub Blöcke_definieren_Steffl()
   'Zeilenblöcke der Mitarbeiter definieren
   Dim Rng As Range
   Dim rngBlock As Range
  
   Dim adr As Variant
   Dim ad1 As Variant
   Dim vntArray() As Variant
  
   Dim Orga As String
   Dim MA As String
   Dim PersNr As String
   Dim AuswNr As String
  
   Dim Anfang As Long
   Dim Ende As Long
 
   With Columns(1)
      i = 1
      Set Rng = .Find("Organisationseinheit:", , xlValues, xlWhole)
      If Not Rng Is Nothing Then
         adr = Rng.Address
         ad1 = Rng.Address
       
         Do
            ad1 = Rng.Address
            ReDim Preserve vntArray(i - 1)
            vntArray(i - 1) = Rng.Row
            Set Rng = .FindNext(Rng)
            Range(Range(ad1), Rng.Offset(-1)).Name = "Block" & i
            i = i + 1
         Loop Until Rng.Address = adr
      End If
      ReDim Preserve vntArray(i - 1)
      vntArray(i - 1) = .Cells(.Rows.Count, 1).End(xlUp).Row + 4
   End With
  
   'Texte in Spalte BF:BI kopieren
      For i = 0 To UBound(vntArray) - 1
          Set rngBlock = Range(Cells(vntArray(i), 1), Cells(vntArray(i + 1) - 9, 61))
'          MsgBox "Der Block " & i + 1 & " umfasst den Bereich " & rngBlock.Address
         
          Orga = rngBlock.Cells(1, 12).Value 'Organisationseinheit
          rngBlock.Columns(58).Value = Orga
          MA = rngBlock.Cells(2, 12).Value 'Name
          rngBlock.Columns(59).Value = MA
          PersNr = rngBlock.Cells(1, 55).Value 'Personalnummer
          rngBlock.Columns(60).Value = PersNr
          AuswNr = rngBlock.Cells(2, 55).Value 'Ausweisnummer
          rngBlock.Columns(61).Value = AuswNr
         
      Next i
End Sub

  Monatsjournal Blockbearbeitung.xlsb (Größe: 36,11 KB / Downloads: 8)

[snb]

Hier geht das einfacher:

Code:

Sub M_snb()
  Tabelle3.Columns(1).Replace "0.00", "", 1

  with Tabelle3.Columns(1).SpecialCells(2)
    MsgBox .Areas.Count & vblf & .Areas(1).Address & vbLf & .Areas(2).Address & vbLf & .Areas(3).Address & vbLf & .Areas(4).Address
  end with
End Sub

[Rabe]

Hallo,

nun habe ich noch ein Thema, das zwischendrin auftaucht:

Bei der Umwandlung des Datums für die Spalte A macht Excel aus den ersten 12 Zeilen des Monats MM.TT.JJJJ statt TT.MM.JJJJ

Wie kann ich das umgehen?

  Monatsjournal - Datum wandeln.xlsb (Größe: 36,42 KB / Downloads: 4)

Gruß Ralf