У меня есть лист с 69 столбцами и 6600 строками, называемыми необработанными данными. У меня также есть лист под названием фильтрованные данные. У меня есть выпадающее меню на отфильтрованном листе данных в ячейке B4. Список в раскрывающемся меню соответствует столбцам данных в необработанном листе данных. Я использую ячейку B5 для ввода минимального значения и ячейку B6 для ввода максимального значения. Я хочу отфильтровать необработанный лист данных в соответствии со столбцом, выбранным через раскрывающееся меню, так что значения в этом столбце больше или равны моему минимальное значение и меньше или равно моему максимальному значению.
код не фильтруется.
Private Sub ExtractData(ByVal Filter As Range)
'Dim variables
Dim LR As Long, NR As Long
Dim filterItem As String
Dim minValue As Variant, maxValue As Variant
Dim colNum As Integer
Dim rng As Range, min As Range, max As Range
Dim shSource As Worksheet
Dim shDest As Worksheet
'Set range and source and target worksheets
Set shSource = ThisWorkbook.Sheets("Raw Data")
Set shDest = ThisWorkbook.Sheets("Filtered Data")
'shSource.Range("D11:BP11") is the list of all possible drop down menu items
Set rng = shSource.Range("D11:BP11")
'Set min and max filter cells
Set min = shDest.Range("B5")
Set max = shDest.Range("B6")
'Define min and max filter values
minValue = shDest.Range("B5").Value
maxValue = shDest.Range("B6").Value
filterItem = Filter.Value
'Determine which column contains the filter category
colNum = Application.Match(filterItem, rng, 0)
If Not IsError(colNum) Then
Select Case colNum
Case 1 To 3: 'Columns B to F
min.NumberFormat = "@" 'string format
max.NumberFormat = "@"
Case 4 To 11, 14, 22 To 23, 29, 33 To 37, 46 To 47, 57, 60 To 61, 63, 65:
min.NumberFormat = "0.00" 'number format
max.NumberFormat = "0.00"
Case Else:
min.NumberFormat = "0.00%" 'percentage format
max.NumberFormat = "0.00%"
End Select
NR = shDest.Range("A" & rows.Count).End(xlUp).Offset(1).Row 'Go to cell below last used cell in column A
With shSource
LR = .Cells(rows.Count, "A").End(xlUp).Row 'Last row of column A
.AutoFilterMode = False
With .Range("A12" & LR)
.AutoFilter Field:=colNum, Criteria1:=">=" & minValue, Operator:=xlAnd, Criteria2:="<=" & maxValue, VisibleDropDown:=False
.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy shDest.Range("A" & NR)
.AutoFilter
End With
End With
Else
MsgBox filterItem + " filter criterion was not found."
End If
shDest.Activate
End Sub