Data uit een rooster uitlezen en een datumarray?

  • Onderwerp starter Onderwerp starter VBA1
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.

VBA1

Gebruiker
Lid geworden
24 okt 2013
Berichten
30
Hallo allemaal,

Ik probeer al een tijdje een sheet te vullen op basis van oa wel of geen verlofdata. Ik heb daarvoor een routine vuldata geschreven, die liep eerst vast. Nu probeer ik de verlofdata per persoon in een array te stoppen maar dat lukt niet. De bedoeling is dat als een medewerker (Blad2) nul uren, 0%claim of verlof heeft, hij of zij niet wordt geselecteerd. Ik zal hieronder de voorbeeldcode zetten van de selecteer routine. Ik kan het bestand niet uploaden dat is de te groot.

Ter verduidelijking: De verlof data staan per rij, resp. kolom 16,17 18,19 20,21 22,23 23,24 24,25 25,26 en 26,27. De eerste kolom is dan "van" en de tweede "tot" Is dat in een array te plaatsen die als datums is uit te lezen?

Code:
Public Sub VulBlad(dag As String)
        Dim DagNummerE, DagNummerO As Integer
        Dim Datum
        Dim DatumArray
        Dim variabele As Integer
        Dim teller As Integer
        
        
        Let variabele = Val(frmWeek.txtVooruit.Text)
        If dag = "Maandag" And variabele = 0 Then
            variabele = 3
        Else
            If variabele = 0 Then variabele = 1
        End If

        Let Datum = Date + variabele
        
        Let Rij2 = 2
        Let Rij4 = 4
        Let aantalcellen2 = Blad2.Range("A65500").End(xlUp).Row
        
        If dag = "Maandag" Then
            Let DagNummerE = 4
            Let DagNummerO = 9
        End If
        If dag = "Dinsdag" Then
            Let DagNummerE = 5
            Let DagNummerO = 10
        End If
        If dag = "Woensdag" Then
            Let DagNummerE = 6
            Let DagNummerO = 11
        End If
        If dag = "Donderdag" Then
            Let DagNummerE = 7
            Let DagNummerO = 12
        End If
        If dag = "Vrijdag" Then
            Let DagNummerE = 8
            Let DagNummerO = 13
        End If

        
        Do While Rij2 <= aantalcellen2
        For teller1 = 16 To 26 Step 2
          For teller2 = 17 To 27 Step 2
            Let DatumArray = Array(Blad2.Cells(Rij2, teller1).Value, Blad2.Cells(Rij2, teller2).Value)
          Next teller2
        Next teller1
            If Datum <> DatumArray Then
                If frmWeek.lblWk2.Caption = "even" Then
                    Let somwerkurenweek = Blad2.Cells(Rij2, 4).Value + Blad2.Cells(Rij2, 5).Value + Blad2.Cells(Rij2, 6).Value + Blad2.Cells(Rij2, 7).Value + Blad2.Cells(Rij2, 8).Value
                    If Not somwerkurenweek = 0 Then
                        If Not Blad2.Cells(Rij2, 3) = 0 Then
'                            If Dag = "Maandag" Then
                                If Not Blad2.Cells(Rij2, DagNummerE).Value = 0 Then
                                    Let Blad4.Cells(Rij4, 4).Value = Blad2.Cells(Rij2, DagNummerE).Value
                                    Let Blad4.Cells(Rij4, 5).Value = somwerkurenweek
                                    Let Blad4.Cells(Rij4, 6).Value = Blad2.Cells(Rij2, 3).FormulaR1C1
                                    Let Blad4.Cells(Rij4, 3).Value = Blad2.Cells(Rij2, 1).Value
                                    Let Blad4.Cells(Rij4, 1).Value = Blad2.Cells(Rij2, 2).Value
                                    Let Blad4.Cells(Rij4, 2).Value = Blad2.Cells(Rij2, 15).Value
                                End If
'                            End If
                        End If
                    End If
                End If
                If frmWeek.lblWk2.Caption = "oneven" Then
                    Let somwerkurenweek = Blad2.Cells(Rij2, 9).Value + Blad2.Cells(Rij2, 10).Value + Blad2.Cells(Rij2, 11).Value + Blad2.Cells(Rij2, 12).Value + Blad2.Cells(Rij2, 13).Value
                        If Not somwerkurenweek = 0 Then
                            If Not Blad2.Cells(Rij2, 3) = 0 Then
'                                If Dag = "Maandag" Then
                                    If Not Blad2.Cells(Rij2, DagNummerO).Value = 0 Then
                                        Let Blad4.Cells(Rij4, 4).Value = Blad2.Cells(Rij2, DagNummerO).Value
                                        Let Blad4.Cells(Rij4, 5).Value = somwerkurenweek
                                        Let Blad4.Cells(Rij4, 6).Value = Blad2.Cells(Rij2, 3).FormulaR1C1
                                        Let Blad4.Cells(Rij4, 3).Value = Blad2.Cells(Rij2, 1).Value
                                        Let Blad4.Cells(Rij4, 1).Value = Blad2.Cells(Rij2, 2).Value
                                        Let Blad4.Cells(Rij4, 2).Value = Blad2.Cells(Rij2, 15).Value
                                    End If
'                                End If
                            End If
                        End If
                End If
            End If
            Let Rij2 = Rij2 + 1
            If somwerkurenweek = 0 Or Blad2.Cells(Rij2, 3).Value = 0 Or Blad2.Cells(Rij2, DagNummerO).Value = 0 Or Blad2.Cells(Rij2, DagNummerE).Value = 0 Or Datum >= Blad2.Cells(Rij2, 16).Value And Datum <= Blad2.Cells(Rij2, 17).Value Then
                Let Rij4 = Rij4
            Else: Let Rij4 = Rij4 + 1
            End If
'            Let Rij4 = Rij4 + 1
        Loop
        Call DeFormule
End Sub


Alvast heel erg bedankt, ik hoop dat iemand hier uit komt.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan