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 值。我尝试了很多但没有任何效果。

我是这样调用函数的：Call Gegevens_Ophalen(2, "W", "ProductieUren", 1)。

我在 Internet 上进行了搜索，但找不到真正接近的东西。我找到了这个 link 但无法真正将其放入我自己的代码中：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

VBA Excel 范围偏移

VBA Excel range offset

excel

vba

range

offset