Мои навыки VBA не самые лучшие, если бы кто-то мог помочь со следующим, это было бы здорово.

У меня есть несколько листов в книге с записью даты в диапазоне ячеек E11: E37.

Я пытаюсь создать функцию отчетности, с помощью которой пользователь заполняет пользовательскую форму выбора даты, Excel выполняет поиск в указанном выше диапазоне на всех листах этой книги для даты, которая находится между результатами DTPicker1 / 2.

Для листов, которые возвращают совпадение, скопируйте все эти листы в новую книгу с именем («Имя и текущая дата» .xlsx).

Обновление: я попытался поменять местами> и <, без изменений, думаю, я завернул в Cdate для значений DTPicker, нет результатов, сделал и то, и другое, без результатов ....

Обновление: код теперь работает, но не возвращает значение true, где даты в диапазоне = 01.06.18 - 14.06.18, где DTP1 = 07.06.18 и DTP2 = 16.06.18. Но возвращает истину, если DTP1 = 04.06.18 и DTP2 = 08.06.18.

Private Sub CommandButton1_Click()
Dim s As Worksheet, wb As Workbook

For Each s In Worksheets
    If CBool(Application.CountIfs(s.Range("E11:E37"), ">" & 
CDate(DTPicker1.Value), _
                                  s.Range("E11:E37"), "<" & 
CDate(DTPicker2.Value))) Then
        If wb Is Nothing Then
            s.Copy
            Set wb = ActiveWorkbook
        Else
            s.Copy after:=wb.Worksheets(wb.Worksheets.Count)
        End If
    End If
Next s

If wb Is Nothing Then
    MsgBox ("No Records Found")
Else
    wb.SaveAs Filename:="Technicians - Batch Record Report" & Format(Date, 
"ddmmyyyy"), _
          FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End If
End Sub
0
Dan Sutton 9 Июн 2018 в 17:44

1 ответ

Лучший ответ

Попробуйте это, чтобы увидеть, приблизит ли это вас к вашей цели.

Private Sub CommandButton1_Click()
    Dim s As Worksheet, wb as workbook

    For Each s In workSheets
        If cbool(application.countifs(s.Range("I11:I37"), ">" & cdate(DTPicker1.Value), _
                                      s.Range("I11:I37"), "<" & cdate(DTPicker2.Value))) then
            if wb is nothing then
                s.copy
                set wb = activeworkbook
            else
                s.copy after:=wb.worksheets(wb.worksheets.count)
            end if
        end if
    next s

    if wb is nothing then
        MsgBox ("No Records Found")
    else
        wb.SaveAs Filename:="Technicians - Batch Record Report" & Format(Date, "ddmmyyyy"), _
              FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    End If
End Sub
0
9 Июн 2018 в 15:15