VBA Excel范围偏移

我有这样的：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

我现在需要的是，在“范围偏移我需要把值返回到Excel当前weeknumber减1 如果是例如16周，我的价值需要放在正确的一周。通过参数Rij，我给出了右一周的rowoffset的值。我尝试了很多，但没有任何效果。

这就是我所说的功能：调用Gegevens_Ophalen（2，“W”，“ProductieUren”，1）。

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

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

来源

2017-05-18 EfhK

你能否简要解释一下你的代码已经做了什么。你也应该使用'Set ws = ThisWorkbook.Worksheets（sheetname）'并使用'with ws'来使你的代码更具可读性。 – UGP

我的代码已经循环遍历不同的表单以获取需要重新放入excel的值。用debug.print我检查并得到正确的值。感谢提示，使代码更具可读性。我将把它改成我的真实代码。 – EfhK

如果我正确地理解了你，你只需要一种方法来获得本周的偏移量。此宏将获取一个值并将其粘贴到本周的列中。尝试一下并为您的工作簿进行修改。

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

来源

2017-05-18 20:05:09 UGP

非常感谢！我首先想到它不可能是正确的，但在尝试并修改它之后，它完美地工作！ – EfhK

VBA Excel范围偏移

回答

相关问题