英文:
Excel VBA filter for multiple case independent "Contains" criteria
问题
我需要过滤列E（该列包含文本值），以便筛选出包含列表中任何值（"ALL"，"SUPER"，"EXTRA"）的值，筛选应不区分大小写。例如，筛选应保留"Fall"，"fAll"，"FaLL"（不区分大小写的"ALL"），以及"Dextra"。某种方式，我无法使用UI完成它。逐行检查instring是最后的选择，但如果使用VBA筛选，将更适合目前的工作。非常感谢任何帮助。
英文:
I need to filter column E (column has text values) for any value that contains any of the values from the list ("ALL", "SUPER", "EXTRA") and the filter should be case independent. For example filter should retain "Fall", "fAll", "FaLL" (case independent for "ALL") and "Dextra".
Somehow I could not do it with UI. Row by row checking with instring is the last option but if done by VBA filter it would better suit the present work. Any help greatly appreciated.
答案1
得分: 1
以下是您要翻译的代码部分：
Sub filterByPartialStrins()Dim sh As Worksheet, colMark As Range, lastR As Long, lastC As LongDim arrCrit(), arr, arrMark, El, i As LongConst markName As String = "Marker_column"arrCrit = Array("ALL", "SUPER", "EXTRA") 'place partial criteria in an arraySet sh = ActiveSheet 'use here the sheet you needIf sh.AutoFilterMode Then sh.AutoFilterMode = False 'eliminate the filter, if anylastR = sh.Range("E" & sh.Rows.Count).End(xlUp).Row 'last row'determine the column where the marker to be placed:Set colMark = sh.Rows(1).Find(What:=markName, LookIn:=xlValues, LookAt:=xlWhole)If Not colMark Is Nothing ThenlastC = colMark.Column 'for the case when the marker column existsElselastC = sh.Cells(1, sh.Columns.Count).End(xlToLeft).Column + 1 'next empty column if marker column does not existEnd Ifarr = sh.Range("E2:E" & lastR).Value2 'place E:E column in an array for faster processingReDim arrMark(1 To UBound(arr), 1 To 1) 'ReDim the array to keep markersFor i = 1 To UBound(arr)For Each El In arrCrit'place a marker if the necessary condition is true:If InStr(1, arr(i, 1), El, vbTextCompare) > 0 Then arrMark(i, 1) = "OK": Exit ForNext ElNextIf colMark Is Nothing Then sh.Cells(1, lastC).Value = markName 'place the marker column name, IF NOT EXISTS'drop the arrMark content, at once:sh.Cells(2, lastC).Resize(UBound(arrMark), 1).Value2 = arrMark'filter by the marker columnsh.Range("A1").CurrentRegion.AutoFilter lastC, "OK"MsgBox "Ready..."End Sub
希望这有所帮助！
英文:
Please, test the next code, which puts in practice my sugestions from the above comment. It should be fast enough, even for a large range. All processing is done in memory, only the markers array is dropped at once, at the end of the code, followed by filtering on it. This solution assumes that the headers exist in the sheet first row:
Sub filterByPartialStrins()Dim sh As Worksheet, colMark As Range, lastR As Long, lastC As LongDim arrCrit(), arr, arrMark, El, i As LongConst markName As String = "Marker_column"arrCrit = Array("ALL", "SUPER", "EXTRA") 'place partial criteria in an arraySet sh = ActiveSheet 'use here the sheet you needIf sh.AutoFilterMode Then sh.AutoFilterMode = False 'eliminate the filter, if anylastR = sh.Range("E" & sh.rows.count).End(xlUp).Row 'last row'determinte the column where the marker to be placed:Set colMark = sh.rows(1).Find(What:=markName, LookIn:=xlValues, Lookat:=xlWhole)If Not colMark Is Nothing ThenlastC = colMark.column 'for the case when the marker column existsElselastC = sh.cells(1, sh.Columns.count).End(xlToLeft).column + 1 'next empty column if marker column does not existEnd Ifarr = sh.Range("E2:E" & lastR).Value2 'place E:E column in an array for faster processingReDim arrMark(1 To UBound(arr), 1 To 1) 'ReDim the array to keep markersFor i = 1 To UBound(arr)For Each El In arrCrit'place a marker if the necessary condition is true:If InStr(1, arr(i, 1), El, vbTextCompare) > 0 Then arrMark(i, 1) = "OK": Exit ForNext ElNextIf colMark Is Nothing Then sh.cells(1, lastC).Value = markName 'place the marker column name, IF NOT EXISTS'dropo the arrMark content, at once:sh.cells(2, lastC).Resize(UBound(arrMark), 1).Value2 = arrMark'filter by the marker columnsh.Range("A1").CurrentRegion.AutoFilter lastC, "OK"MsgBox "Ready..."End Sub
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论