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。
有没有人有一些想法或一些提示来帮助我?
答
如果我正确地理解了你,你只需要一种方法来获得本周的偏移量。此宏将获取一个值并将其粘贴到本周的列中。尝试一下并为您的工作簿进行修改。
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
你能否简要解释一下你的代码已经做了什么。你也应该使用'Set ws = ThisWorkbook.Worksheets(sheetname)'并使用'with ws'来使你的代码更具可读性。 – UGP
我的代码已经循环遍历不同的表单以获取需要重新放入excel的值。用debug.print我检查并得到正确的值。感谢提示,使代码更具可读性。我将把它改成我的真实代码。 – EfhK