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

VBA Excel范围偏移

1 个答案: