Фильтровать столбец на основе значения внутри ячеек

Я новичок в VBA. Мне нужна помощь в разработке этого фильтра: Мои данные имеют ~ 50 000 строк и 100 столбцов. Столбец, который я хочу отфильтровать, имеет такие значения, как TL-98,263138472% BD-1,736861528%. Я хочу отфильтровать все значения в VBA, где TL> 90%. Я могу придумать длинный способ сделать это — создать цикл, разбить каждую ячейку, затем посмотреть на TL, а затем на 4 числа рядом с ним. Но кажется, что это займет вечность. Хотите знать, есть ли более быстрый/простой способ сделать это? Тоже интересно, а стоит ли. Если бы это заняло даже больше 2 секунд, то я бы не стал делать это с VBA. Я еще не закодировал его, хотел посмотреть, есть ли у кого-нибудь идеи получше, чем то, что придумал я. Заранее спасибо! Добавление примера моих данных ниже:

Кажется, у вас есть хорошее представление о том, как это сделать, так почему бы не написать код и не проверить скорость?

Tim Williams 11.02.2023 02:02
Преобразование HTML-таблицы в профессиональный документ Excel
Преобразование HTML-таблицы в профессиональный документ Excel
Это самый простой способ создания Excel из HTML-таблицы.
Импорт excel в laravel в базу данных
Импорт excel в laravel в базу данных
Здравствуйте, дорогой читатель, в этой статье я расскажу практическим и быстрым способом, как импортировать файл Excel в вашу базу данных с помощью...
2
1
70
3
Перейти к ответу Данный вопрос помечен как решенный

Ответы 3

Фильтрация с помощью вспомогательного столбца таблицы и синтаксического анализа строк

Если вы хотите изучить решения, отличные от 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() для преобразования строки в числовое значение.

Cameron Critchlow 11.02.2023 02:13

Копировать значения (эффективно!?)

Код

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 столбцов.

Другие вопросы по теме