Фильтрация данных в порядке возрастания с использованием ссылки на переменную в Excel - PullRequest
0 голосов
/ 23 октября 2019

Я определил заголовок столбца (Birth_Year), выполнив поиск и сохранив значение в переменной f1. Теперь я хочу применить фильтры и отсортировать данные по Birth_Year, используя f1 в качестве ссылочной переменной.

Пожалуйста, смотрите код ниже:

   Sub age()
      Dim OpenWb As Workbook
      With Application.FileDialog(msoFileDialogFilePicker)
            'Makes sure the user can select only one file
            .AllowMultiSelect = False
            'Filter to just the following types of files to narrow down selection options
            .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
            'Show the dialog box
            .Show

            'Store in fullpath variable
            fullpath = .SelectedItems.Item(1)

            'Actions in raw data sheet

        Set OpenWb = Workbooks.Open(fullpath)
        Dim wsData As Worksheet
        Set wsData = OpenWb.Worksheets("Data")

     'Find last cell number of row A from data sheet
        Dim last As Double
        Dim Cell As Range
        With OpenWb.Worksheets("Data")
        last = .Cells(.Rows.Count, "A").End(xlUp).Row
        End With

    OpenWb.Worksheets("Data").Rows("1:1").Select
    Dim f1 As String

    f1 = Selection.Find(What:="BIRTH_YEAR", After:=ActiveCell, LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).value

        Selection.AutoFilter
        ActiveWorkbook.Worksheets("Data").AutoFilter.Sort.SortFields.Clear
    '    Cells(f1).Sort , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    '        xlSortTextAsNumbers
''Macro recording-Iwant to replace the range C1:C499872 with f1(variabe)        
ActiveWorkbook.Worksheets("Data").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
            "C1:C499872"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortTextAsNumbers
        With ActiveWorkbook.Worksheets("Data").AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With



    End Sub

1 Ответ

0 голосов
/ 23 октября 2019

Попробуйте код ниже не проверено

Sub age()
      Dim OpenWb As Workbook
      With Application.FileDialog(msoFileDialogFilePicker)
            'Makes sure the user can select only one file
            .AllowMultiSelect = False
            'Filter to just the following types of files to narrow down selection options
            .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
            'Show the dialog box
            .Show

            'Store in fullpath variable
            fullpath = .SelectedItems.Item(1)

            'Actions in raw data sheet

        Set OpenWb = Workbooks.Open(fullpath)
        Dim wsData As Worksheet
        Set wsData = OpenWb.Worksheets("Data")

     'Find last cell number of row A from data sheet
        Dim last As Double
        Dim Cell As Range
        With OpenWb.Worksheets("Data")
        last = .Cells(.Rows.Count, "A").End(xlUp).Row
        End With

    OpenWb.Worksheets("Data").Rows("1:1").Select
    Dim f1 As String

    f1 = Selection.Find(What:="BIRTH_YEAR", After:=ActiveCell, LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).value

        Selection.AutoFilter
        ActiveWorkbook.Worksheets("Data").AutoFilter.Sort.SortFields.Clear
    '    Cells(f1).Sort , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    '        xlSortTextAsNumbers
''Macro recording-Iwant to replace the range C1:C499872 with f1(variabe)        
ActiveWorkbook.Worksheets("Data").AutoFilter.Sort.SortFields
 .Add Key:=Range("C1:C499872"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= xlSortTextAsNumbers
        With ActiveWorkbook.Worksheets("Data").AutoFilter.Sort
             .SetRange f1
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With



    End Sub


Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...