2017-05-18 12 views
0

내가이있어 오프셋 :VBA 엑셀 범위는

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

다음은이 함수를 호출하는 방법입니다. Call Gegevens_Ophalen (2, "W", "ProductieUren", 1).

전 인터넷을 검색했지만 실제로 가까이에있는 것을 찾을 수 없습니다. 이 링크를 찾았지만 내 코드에 맞지 않았습니다 : https://www.rondebruin.nl/win/s9/win006.htm.

나를 도와주는 데 도움이되는 사람이 있습니까?

+2

코드가 이미 수행 한 것을 간략하게 설명해 주시겠습니까? 또한'Set ws = ThisWorkbook.Worksheets (sheetname)'을 사용하고'ws '를 사용하여 코드를 읽기 쉽게 만들어야합니다. – UGP

+0

내 코드는 다른 시트를 통해 이미 반복되어 값을 가져 와서 다시 Excel로 가져와야합니다. debug.print를 사용하여 올바른 값을 확인하고 얻었습니다. 팁을 주셔서 코드를 더 읽기 쉽게 만들어 주셔서 감사합니다. 나는 그것을 실제 코드로 바꿀 것이다. – EfhK

답변

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 
+0

정말 고마워요! 나는 처음에는 제대로 될 수 없다고 생각했지만 시도하고 수정 한 후에 완벽하게 작동합니다! – EfhK