VBA Excel范围偏移

Question

我有这个：

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

我现在需要的是，在“范围偏移”处，我需要将当前周数减去 1 的值放回 excel 中。 例如，如果是第 16 周，我的值需要放在正确的一周。使用参数 Rij，我给出了正确一周的 rowoffset 值。我尝试了很多，但没有任何效果。

这就是我调用函数的方式：调用 Gegevens_Ophalen(2, "W", "ProductieUren", 1)。

我在整个互联网上进行了搜索，但实际上找不到任何接近的东西。我找到了此链接，但无法将其真正放入我自己的代码中：https://www.rondebruin.nl/win/s9/win006.htm。

有人有什么想法或提示可以帮助我吗？

Answer 1

如果我理解正确，您只需要一种方法来获取本周的偏移量。此宏获取一个值并将其粘贴到当前一周的列中。试一试并为您的工作簿修改它。

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