VBA 엑셀 범위는

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 마이너스 현재 weeknumber에서 엑셀로 다시 값을 배치해야 오프셋이다 예를 들어 제 16 주를 오른쪽 주에 배치해야합니다. Rij 매개 변수를 사용하여 오른쪽 주에 대한 행 오프셋 값을 제공합니다. 나는 많은 것을 시도했지만 아무 것도 작동하지 않았습니다.

다음은이 함수를 호출하는 방법입니다. Call 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