У меня есть две книгиФункция VBA Weeknum возвращает неверный номер недели?
Workbook 1 = L.O. Линии поставки Tracker
Column G Column M
05/01/2017 (Other Criteria)
09/01/2017 (Other Criteria)
01/01/2017 (Other Criteria)
Рабочая тетрадь 2 = Отчет:
Лист 2
B6 = (Other Criteria)
B9 = 2 D9 = 2017
Лист 3
Column A Col B Col C etc.
Если дата в столбце B на моей доставки следящей книги совпадает с номер недели в B9 и год в D9 (в рабочей книге отчета), затем я хочу скопировать даты (и другие соответствующие значения) в отчетную рабочую книгу, столбцы a, b, c и т. д.
Насколько я могу судить, неделя должна начинаться в понедельник, и поэтому, если я введу «2» в ячейку B9, это должно скопировать даты между Mon 9 - 15 января.
Моя функция недели vba меня забирает 05/01/2017. Это не верно! Это должно быть только 09/01/2017.
Мой желаемый результат:
Отчет книги: Лист 3
Column A
09/01/2017
Это что-то делать с моей функции WEEKNUM в VBA, но я не уверен, что я делаю неправильно. Пожалуйста, кто-нибудь покажет мне, как заставить это работать, как я хочу?
Heres мой код:
Option Explicit
Sub code2()
MsgBox "This will take upto 2 minutes."
Application.ScreenUpdating = False
Dim WB As Workbook
Dim i As Long
Dim j As Long
Dim Lastrow As Long
'On Error Resume Next
'Clear Data Sheet
'On Error GoTo Message
With ThisWorkbook.Worksheets("Data")
.Rows(2 & ":" & .Rows.Count).ClearContents
End With
Set WB = Workbooks("L.O. Lines Delivery Tracker.xlsm")
'On Error GoTo 0
If WB Is Nothing Then 'open workbook if not open
Set WB = Workbooks.Open("C:\Users\Mark O'Brien\Desktop\L.O. Lines Delivery Tracker.xlsm")
End If
' ======= Edit #2 , also for DEBUG ======
With WB.Worksheets(1)
Lastrow = .Cells(.Rows.Count, "G").End(xlUp).Row
j = 2
For i = 7 To Lastrow
' === For DEBUG ONLY ===
Debug.Print CInt(ThisWorkbook.Worksheets(2).Range("B9").value)
Debug.Print WeekNum(.Range("G" & i).value)
Debug.Print CInt(ThisWorkbook.Worksheets(2).Range("D9").value)
Debug.Print Year(.Range("G" & i).value)
Debug.Print ThisWorkbook.Worksheets(2).Range("B6").value
Debug.Print .Range("M" & i).value
If CInt(ThisWorkbook.Worksheets(2).Range("B9").value) = WeekNum(.Range("G" & i).value) Then ' check if Month equals the value in "A1"
If CInt(ThisWorkbook.Worksheets(2).Range("D9").value) = Year(.Range("G" & i).value) Then ' check if Year equals the value in "A2"
If ThisWorkbook.Worksheets(2).Range("B6").value = .Range("M" & i).value Then
ThisWorkbook.Worksheets(3).Range("A" & j).value = .Range("G" & i).value
ThisWorkbook.Worksheets(3).Range("B" & j).Formula = "=WeekNum(A" & j & ",21)"
ThisWorkbook.Worksheets(3).Range("C" & j).value = .Range("L" & i).value
ThisWorkbook.Worksheets(3).Range("D" & j).value = .Range("D" & i).value
ThisWorkbook.Worksheets(3).Range("E" & j).value = .Range("E" & i).value
ThisWorkbook.Worksheets(3).Range("F" & j).value = .Range("F" & i).value
ThisWorkbook.Worksheets(3).Range("g" & j).value = .Range("p" & i).value
ThisWorkbook.Worksheets(3).Range("H" & j).value = .Range("H" & i).value
ThisWorkbook.Worksheets(3).Range("I" & j).value = .Range("I" & i).value
ThisWorkbook.Worksheets(3).Range("J" & j).value = .Range("J" & i).value
ThisWorkbook.Worksheets(3).Range("k" & j).value = .Range("Q" & i).value
ThisWorkbook.Worksheets(3).Range("L" & j).value = .Range("m" & i).value
j = j + 1
End If
End If
End If
Next i
End With
'ThisWorkbook.Worksheets("Data").UsedRange.Columns("B:B").Calculate
'ThisWorkbook.Worksheets(2).UsedRange.Columns("B:AA").Calculate
'On Error GoTo Message
'With ThisWorkbook.Worksheets(2) '<--| change "mysheet" to your actual sheet name
'Intersect(.Range(Rows(14), .UsedRange.Rows(.UsedRange.Rows.Count)), .Range("G:G")).WrapText = True
'Intersect(.Range(Rows(14), .UsedRange.Rows(.UsedRange.Rows.Count)), .Range("G:G")).EntireRow.AutoFit
'End With
'End
Application.ScreenUpdating = True
Exit Sub
Message:
On Error Resume Next
Exit Sub
End Sub
Function WeekNum(D As Date) As Integer
WeekNum = CInt(Format(D, "ww", 2))
End Function
Это помогло бы, если бы вы могли вскипятить весь этот код до нескольких строк, которые иллюстрируют настоящую проблему - на самом деле требуется всего несколько строк, чтобы вызвать функцию WeekNum, а остальная часть не имеет значения –
@TimWilliams извинения I просто пытался построить контекст. Это всего лишь последний бит кода внизу - функция weeknum, которая вызывает проблему, я думаю. – user7415328
Вывод функции WeekNum точно совпадает с листом функции WEEKNUM и BTW, вы, вероятно, не должны использовать одно и то же имя для UDF ... Уверен, что ваша функция перегружается встроенной. Я бы просто использовал встроенную функцию WEEKNUM (и поставьте второй параметр, определяющий, какой день недели должен считаться первым днем) –