Я новичок в VBA. Мне нужна помощь в разработке этого фильтра: Мои данные имеют ~ 50 000 строк и 100 столбцов. Столбец, который я хочу отфильтровать, имеет такие значения, как TL-98,263138472% BD-1,736861528%. Я хочу отфильтровать все значения в VBA, где TL> 90%. Я могу придумать длинный способ сделать это — создать цикл, разбить каждую ячейку, затем посмотреть на TL, а затем на 4 числа рядом с ним. Но кажется, что это займет вечность. Хотите знать, есть ли более быстрый/простой способ сделать это? Тоже интересно, а стоит ли. Если бы это заняло даже больше 2 секунд, то я бы не стал делать это с VBA. Я еще не закодировал его, хотел посмотреть, есть ли у кого-нибудь идеи получше, чем то, что придумал я. Заранее спасибо! Добавление примера моих данных ниже:
Если вы хотите изучить решения, отличные от VBA, вы можете использовать вспомогательный столбец, чтобы решить, что его стоит отфильтровать.
Сначала нам нужно найти в строке «TL-», затем найти «%». После этого:
MID(A4,FIND("TL-",A4)+3,FIND("%",A4,FIND("TL-",A4)+3)-FIND("TL-",A4)-3)
Это просто вернет нам эту подстроку значения, независимо от положения. Теперь нам нужно преобразовать его в значение... и мне сказали, что --() не является правильным способом преобразования строки в значение... но я продолжаю использовать его, и он продолжает работать.
В любом случае, наконец, мы проверяем, больше ли это 90, например:
=IF(--(MID(A4,FIND("TL-",A4)+3,FIND("%",A4,FIND("TL-",A4)+3)-FIND("TL-",A4)-3))>90,"Remove","Keep")
О, я только что вспомнил, я думаю, вы можете использовать Value()
для преобразования строки в числовое значение.
Код
Option Explicit
Sub CopyData()
Dim T As Double: T = Timer
' Read Data: Write the values from the source range to an array.
' Define constants.
Const SRC_NAME As String = "Sheet1"
Const SRC_COLUMN As Long = 44
Const CRIT_STRING_LEFT As String = "TL-"
Const CRIT_VALUE_GT As Double = 90
Const DST_NAME As String = "Sheet2"
' Reference the workbook.
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Reference the source range.
Dim sws As Worksheet: Set sws = wb.Sheets(SRC_NAME)
Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion
Dim srCount As Long: srCount = srg.Rows.Count
Dim cCount As Long: cCount = srg.Columns.Count
' Write to the array (practically this line uses up all the time).
Dim Data(): Data = srg.Value ' assumes at least two cells in 'srg'
Debug.Print "Read Data: " & Format(Timer - T, "0.000s")
T = Timer
' Modify Data: Write the critical values to the top of the array.
Dim cLen As Long: cLen = Len(CRIT_STRING_LEFT)
Dim dr As Long: dr = 1 ' skip headers
Dim sr As Long, c As Long
Dim cPos As Long, cNum As Double, cString As String
For sr = 2 To srCount ' skip headers
cString = CStr(Data(sr, SRC_COLUMN))
cPos = InStr(1, cString, CRIT_STRING_LEFT, vbTextCompare)
If cPos > 0 Then
cString = Right(cString, Len(cString) - cPos - cLen + 1)
cString = Replace(cString, "%", "")
cNum = Val(cString) ' 'Val' doesn't work with "!,@,#,$,%,&,^"
If cNum > CRIT_VALUE_GT Then ' 'Evaluate' is too slow!
dr = dr + 1
For c = 1 To cCount
Data(dr, c) = Data(sr, c)
Next c
End If
End If
Next sr
Debug.Print "Modify Data: " & Format(Timer - T, "0.000s")
T = Timer
' Write Data: Write the values from the array to the destination range.
If dr = 0 Then Exit Sub ' no filtered values
' Reference the destination range.
Dim dws As Worksheet: Set dws = wb.Sheets(DST_NAME)
Dim drg As Range: Set drg = dws.Range("A1").Resize(dr, cCount)
' Write to the range (practically this line uses up all the time).
drg.Value = Data
' Clear below
drg.Resize(dws.Rows.Count - drg.Row - dr + 1).Offset(dr).Clear
Debug.Print "Write Data: " & Format(Timer - T, "0.000s")
MsgBox "Data copied.", vbInformation
End Sub
Результат (прошло время)
В выборке из 50k
строк по 100
столбцам данных с 26k
совпадениями код заканчивался под 5s
:
Read Data: 1.336s
Modify Data: 0.277s
Write Data: 3.375s
Не было пустых ячеек, и каждая ячейка в столбце критериев содержала строку критериев с процентом, поэтому она должна быть быстрее для ваших данных. Ваш отзыв ожидается.
Довольно быстро в моих тестах:
Sub tester()
Dim ws As Worksheet, t
Dim i As Long, rng As Range, rngFilt As Range, arr, arrFilt
' For i = 2 To 50000 'create some dummy data
' Cells(i, "A") = "TL-" & 50 + (Rnd() * 60) & "% BD-1.736861528%"
' Next i
' [B2:CV50000].value = "blah" 'fill rest of table
t = Timer
Set ws = ActiveSheet
If ws.FilterMode Then ws.ShowAllData
Set rng = ws.Range("A1:A" & ws.Cells(Rows.Count, "A").End(xlUp).Row) 'range of values to filter
Set rngFilt = rng.Offset(0, 110) 'a range off to the right to filter on
arr = rng.Value
arrFilt = rngFilt.Value 'for holding filtering flags
arrFilt(1, 1) = "Filter" 'column header
For i = 2 To UBound(arr, 1)
arrFilt(i, 1) = IIf(FilterOut(arr(i, 1)), "Y", "N")
Next i
rngFilt.Value = arrFilt
rngFilt.AutoFilter field:=1, Criteria1: = "N"
Debug.Print Timer - t
End Sub
'does this value need to be filtered out?
Function FilterOut(v) As Boolean
Dim pos As Long
pos = InStr(v, "TL-")
If pos > 0 Then
v = Mid(v, pos + 3)
pos = InStr(v, "%")
If pos > 0 Then
v = Left(v, pos - 1)
'Debug.Print v
If IsNumeric(v) Then FilterOut = v > 90
End If
End If
End Function
Для меня это выполнялось менее чем за 0,3 секунды в наборе данных 50 тыс. строк X 100 столбцов.
Кажется, у вас есть хорошее представление о том, как это сделать, так почему бы не написать код и не проверить скорость?