Clever-Excel-Forum

Seiten: 1 2 3 4

Hallo,

leider war diese Woche zu viel los.

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

Zitat: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

(12.02.2021, 12:58)Fennek schrieb: [ -> ]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

Hallo Ralf,

2 Dinge:

1) das mit dem & ist perfekt Smile

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

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?

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 Smile

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 Smile

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.

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
[attachment=37300]

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

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

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

[attachment=37314]

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

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?
[attachment=37336]

Gruß Ralf

Seiten: 1 2 3 4

Rabe

schauan

Rabe

schauan

Rabe

Gast 123

Steffl

Rabe

snb

Rabe