Удаление ключевых слов из файла Excel с помощью VBA

#excel #vba

#excel #vba

Вопрос:

У меня есть список ключевых слов, которые я хочу найти, и удалить всю строку в электронной таблице. Цель состоит в том, чтобы найти эти ключевые слова, заменить их на «# N / A», а затем удалить связанные строки.

Прямо сейчас я получаю сообщение об ошибке в предпоследней строке кода, в котором говорится: «Ошибка времени выполнения ‘1004’: ячейки не найдены». Это имеет смысл, поскольку я понял, что мне нужно найти строку «# N / A», а не ошибку.

Я изо всех сил пытаюсь придумать способ удаления строк, связанных со строкой «# N / A».

 Option Explicit

Sub Delete_EEE()

Dim Wrds As Variant, Gwrd As String
Dim i As Long

Gwrd = "Jans"
Wrds = Array("ohm", "resistor", "MCKT", "micro", "inductor")

Range("G:G").Replace Gwrd, "#N/A", xlPart, , False

Application.ScreenUpdating = False

For i = LBound(Wrds) To UBound(Wrds)
    Range("E:E").Replace Wrds(i), "#N/A", xlPart, , False
    Range("I:I").Replace Wrds(i), "#N/A", xlPart, , False
Next i

Range("E:I").SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete

Application.ScreenUpdating = True

End Sub
 

Комментарии:

1. Почему бы просто не перебрать все строки, если текст существует EntireRow.Delete

Ответ №1:

Вам нужно начать с последней строки с данными и продвигаться вверх, когда вы захотите удалить строки. А ниже вы найдете фрагмент кода для проверки, есть ли какое-либо значение в вашем массиве в исходной строке, которая может быть содержимым ячейки.

 '********************************************************************************************************************
' To check if any word from an array is within the source string
' Duplicate blanks are removed and strings put in lower case for the validation
' Returns False if there was an error or no item was found
'********************************************************************************************************************
Public Function isFromArrInSentence(ByVal strSource As Variant, ByVal wordsArray As Variant) As Boolean
Dim tmpBool As Boolean, x As Long

tmpBool = False
If VarType(strSource) = vbString And IsArray(wordsArray) Then
    strSource = LCase(Application.WorksheetFunction.Trim(strSource))
    If Len(strSource) > 0 Then
        If Not isEmpty(wordsArray) Then
            For x = LBound(wordsArray) To UBound(wordsArray)
                If InStr(1, strSource, LCase(Application.WorksheetFunction.Trim(wordsArray(x)))) > 0 Then
                    tmpBool = True
                    Exit For
                End If
            Next x
        End If
    End If
End If
isFromArrInSentence = tmpBool

End Function
 

Ответ №2:

Если столбец содержит ваше значение именно так, как оно отображается, вам вообще не нужно выполнять цикл. Просто отфильтруйте по вашим значениям и удалите видимый диапазон

 Option Explicit

Sub iDelete()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")

Dim Arr, LR As Long, DeleteMe As Range
Arr = Array("ohm", "resistor", "MCKT", "micro", "inductor")

LR = ws.Range("G" amp; ws.Rows.Count).End(xlUp).Row
ws.Range("G:G").AutoFilter 1, Arr, xlFilterValues

Set DeleteMe = ws.Range("G2:G" amp; LR).SpecialCells(xlCellTypeVisible)

If Not DeleteMe Is Nothing Then
    DeleteMe.EntireRow.Delete
End If

End Sub
 

Комментарии:

1. Интересно, я попробую это сделать.

Ответ №3:

Это должен быть более простой метод:

 LastRow = Cells(Rows.Count, 7).End(xlUp).Row

For CurRow = LastRow to 1 Step -1
    GVal = Cells(CurRow, 7).Value 'column G
    Select Case True
        Case GVal Like "*ohm*", GVal Like "*resistor*", GVal Like "*MCKT*", GVal Like "*micro*", GVal Like "*inductor*"
            Cells(CurRow, 7).EntireRow.Delete xlShiftUp
    End Select
    EVal = Cells(CurRow, 5).Value 'column E
    Select Case True
        Case EVal Like "*ohm*", EVal Like "*resistor*", EVal Like "*MCKT*", EVal Like "*micro*", EVal Like "*inductor*"
            Cells(CurRow, 7).EntireRow.Delete xlShiftUp
    End Select
    IVal = Cells(CurRow, 9).Value 'column I
    Select Case True
        Case IVal Like "*ohm*", IVal Like "*resistor*", IVal Like "*MCKT*", IVal Like "*micro*", IVal Like "*inductor*"
            Cells(CurRow, 7).EntireRow.Delete xlShiftUp
    End Select
Next CurRow
 

Комментарии:

1. Спасибо, я попробую это в ближайшее время!

2. @Christmas007 Я получаю ошибку «Несоответствие типов» в четвертой строке кода, начинающейся с «Case»

3. Также имейте в виду, что ключевые слова могут быть частью более длинной строки. Поэтому я использовал xlPart в своем исходном коде.

4. @CC268 Я исправил проблему, добавив запятые в регистре вместо ИЛИ… Я работаю над решением вашей проблемы «часть большей строки»…

5. @CC268I добавил like код для обработки более длинных строк, которые должны работать