gamme décalage

Question

J'ai ceci:

Public Function Gegevens_Ophalen(ByVal ParameterRow As Integer, ByVal KolomLetterSOM As String, ByVal sheetname As String, ByVal Rij As Integer) As Single 

Dim WB1 As Workbook 
Dim WB2 As Workbook 
Dim WS As Worksheet 
Dim Filter As Object 
Set Filter = CreateObject("scripting.dictionary") 
Set Eenheden = CreateObject("scripting.dictionary") 
Set Processen = CreateObject("scripting.dictionary") 
Set Looptijd = CreateObject("scripting.dictionary") 
Set WB1 = Workbooks("KOW.xlsm") 
Set WB2 = ActiveWorkbook 
Set WS = WB2.Sheets("Page1_1") 
Debug.Print ("Start: " & Now()) 
Dim Eenheid As String 
Dim Medewerker_Kolom As String 
Dim RN As Single: RN = 10 
Dim PR As Single: PR = 0 
Dim som As Single: som = 0 

Do Until ThisWorkbook.Sheets(sheetname).Range("B" & ParameterRow + PR).Value = "" 
    If (ThisWorkbook.Sheets(sheetname).Range("B" & ParameterRow + PR).Value = "Kolom H (eenheid) =") Then 
     Eenheden(LCase(ThisWorkbook.Sheets(sheetname).Range("C" & ParameterRow + PR).Value)) = "filteren" 
     Debug.Print (LCase(ThisWorkbook.Sheets(sheetname).Range("C" & ParameterRow + PR).Value)) 
    ElseIf (ThisWorkbook.Sheets(sheetname).Range("B" & ParameterRow + PR).Value = "Kolom K (naam Medew) =") Then 
     Filter(LCase(ThisWorkbook.Sheets(sheetname).Range("C" & ParameterRow + PR).Value)) = "filteren" 
     Debug.Print (LCase(ThisWorkbook.Sheets(sheetname).Range("C" & ParameterRow + PR).Value)) 
    ElseIf (ThisWorkbook.Sheets(sheetname).Range("B" & ParameterRow + PR).Value = "Kolom D (proces) = ") Then 
     Processen(LCase(ThisWorkbook.Sheets(sheetname).Range("C" & ParameterRow + PR).Value)) = "filteren" 
     Debug.Print (LCase(ThisWorkbook.Sheets(sheetname).Range("C" & ParameterRow + PR).Value)) 
    ElseIf (ThisWorkbook.Sheets(sheetname).Range("B" & ParameterRow + PR).Value = "Kolom Y (looptijdcat) =") Then 
     Looptijd(LCase(ThisWorkbook.Sheets(sheetname).Range("C" & ParameterRow + PR).Value)) = "filteren" 
     Debug.Print (LCase(ThisWorkbook.Sheets(sheetname).Range("C" & ParameterRow + PR).Value)) 
    Else 
     ' 
    End If 
    PR = PR + 1 
Loop 

Eenheid = ThisWorkbook.Sheets(sheetname).Range("C" & ParameterRow).Value 

Do Until WS.Range("A" & RN).Value = "" 
    If sheetname <> "Kleiner10" Or sheetname <> "10-30" Or sheetname <> "Groter30" Or sheetname <> "Doelen" Then 
     If (Eenheden(LCase(WS.Range("H" & RN).Value)) = "filteren") Then 
      If (Filter(LCase(WS.Range("K" & RN).Value)) = "filteren" Or Processen(LCase(WS.Range("D" & RN).Value)) = "filteren") Then 
       ' niks doen 
      Else 
       som = som + Sheets("Page1_1").Range(KolomLetterSOM & RN).Value 
      End If 
     End If 
    ElseIf sheetname = "Doelen" Then 
     If (Eenheden(LCase(WS.Range("H" & RN).Value)) = "filteren") And (Processen(LCase(WS.Range("Y" & RN).Value)) = "filteren") Then 
      som = som + Sheets("Page1_1").Range(KolomLetterSOM & RN).Value 
     End If 
    ElseIf (Eenheden(LCase(WS.Range("H" & RN).Value)) = "filteren") And (Looptijd(LCase(WS.Range("Y" & RN).Value)) = "filteren") Then 'Doorlooptijden 
      If (Filter(LCase(WS.Range("K" & RN).Value)) = "filteren" Or Processen(LCase(WS.Range("D" & RN).Value)) = "filteren") Then 
       ' niks doen 
      Else 
       som = som + Sheets("Page1_1").Range(KolomLetterSOM & RN).Value 
      End If 
    End If 
    RN = RN + 1 
Loop 

Debug.Print ("Eind: " & Now()) 
Bulk_Voorraad = som 
Debug.Print som 

' range offset 

End Function 

Ce que je dois maintenant est que le « plage de décalage que je dois placer les valeurs de retour dans Excel dans le courant moins 1. Semaine n ° Si elle est semaine 16 par exemple mes valeurs doivent être placées dans la bonne semaine. Avec le paramètre Rij je donne la valeur du rowoffset pour la bonne semaine. J'ai beaucoup essayé mais rien qui fonctionne.

Voici comment j'appelle la fonction: Appelez Gegevens_Ophalen (2, "W", "ProductieUren", 1).

J'ai cherché partout sur internet mais je n'ai pas vraiment trouvé quelque chose qui se rapproche. J'ai trouvé ce lien mais je ne pouvais pas vraiment l'intégrer dans mon propre code: .

Avez-vous des idées ou des conseils pour m'aider?

Answer 1

Si je vous ai bien compris, vous avez juste besoin d'un moyen d'obtenir le décalage pour la semaine en cours. Cette macro prend une valeur et la colle dans la colonne pour la semaine en cours. Essayez-le et modifiez-le pour votre classeur.

Sub InsertValues() 
Dim Start, i, Value As Integer 
Start = 2 'Start Columns(First Week) (i.e "B" for Week 1) 
CKW = DINKw(Date) 
i = 2 
Value = 2 
ThisWorkbook.Worksheets("Tabelle1").Cells(i, Start + CKW - 1).Value = Value 'Paste Value in current Week 'i = row 'Value = Your Value 
End Sub 

Function DINKw(Datum As Date) As Integer 
Dim lngT As Long 
    lngT = DateSerial(Year(Datum + (8 - Weekday(Datum)) Mod 7 - 3), 1, 1) 
    DINKw = ((Datum - lngT - 3 + (Weekday(lngT) + 1) Mod 7)) \ 7 + 1 
End Function