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