VBA Excel范围偏移量

我有这个:

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的值。 我尝试了很多,但没有任何作品。

这就是我所说的function:Call Gegevens_Ophalen(2,“W”,“ProductieUren”,1)。

我在互联网上search,但无法find任何接近的东西。 我发现这个链接,但不能真正适合我自己的代码: https : //www.rondebruin.nl/win/s9/win006.htm 。

有没有人有一些想法或一些提示来帮助我?

如果我正确地理解你,你只需要一种方法来获得本周的抵消。 这个macros将获取一个值并将其粘贴到当前星期的列中。 试试看,并修改它为您的工作簿。

 Sub InsertValues() Dim Start, i, Value As Integer Start = 2 'Start Columns(First Week) (ie "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