Пользовательская форма, как добавить диапазон фильтра даты - PullRequest
Новая
       6

Пользовательская форма, как добавить диапазон фильтра даты

0 голосов
/ 30 мая 2018

Я хочу использовать опцию Userform для фильтров даты, пользователь введет «время начала» и «время окончания», и все соответствующие данные будут отображаться в соответствии с этим фильтром.

Я использовал локальный макрос, который использует дваразные ячейки для ввода данных, но просмотр файла плох, и поэтому я хочу использовать опцию Useform.

Мой код: 

Public Sub MyFilter()
    Dim lngStart As Date, lngEnd As Date
    lngStart = Range("b2").Value 'assume this is the start date
    lngEnd = Range("b3").Value 'assume this is the end date
    Range("q:q").AutoFilter Field:=1, _
        Criteria1:=">=" & lngStart, _
        Operator:=xlAnd, _
        Criteria2:="<=" & lngEnd


           Range("A1:s3000").Select
    Range("A:A").Activate
    Selection.Copy
    Sheets.Add After:=ActiveSheet
With ActiveSheet
    .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    .Columns("A:A").EntireColumn.AutoFit
    .Cells.Select
    .Cells.EntireColumn.AutoFit
    .Rows("1:1").Select
    .Application.CutCopyMode = False
    With Selection
         With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 15773696
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        .AutoFilter
           Columns("Q:Q").Select
    Selection.NumberFormat = "[$-409]m/d/yy h:mm AM/PM;@"
    End With
    .Columns("A:A").EntireColumn.AutoFit
    .Range("A2").Select
End With

End Sub

Код также копирует данные на новый лист(есть идеи, как скопировать его в новый файл?) и изменить формат некоторых ячеек.

Спасибо !!

1 Ответ

0 голосов
/ 30 мая 2018

Для копирования буфера вставки в новый файл добавьте новый файл (вместо листа): 

Set fNew = = Workbooks.Add(xlWBATWorksheet)
 ...
fNew.SaveAs Filename:=<file specification>

Paste:=xlPasteValues буквально копирует значения без форматирования, комментариев, границ и т. Д. Для сохраненияИсходный формат, просто используйте ActiveSheet.Paste Destination:=Range("A1").Если - по какой-либо причине - это не работает, вы можете попробовать это: 

.Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Для копирования только отфильтрованных строк используйте это: 

Range("A1:S3000").SpecialCells(xlCellTypeVisible).Copy
fNew.Sheets(1).Range("A1").PasteSpecial
...