Удалить ключевые слова из файла Excel с помощью VBA - PullRequest
1 голос
/ 18 апреля 2019

У меня есть список ключевых слов, которые я хочу найти и удалить всю строку в электронной таблице.Цель состоит в том, чтобы найти эти ключевые слова, заменить их на «# 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

Ответы [ 3 ]

1 голос
/ 18 апреля 2019

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

'********************************************************************************************************************
' 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
1 голос
/ 18 апреля 2019

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

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" & ws.Rows.Count).End(xlUp).Row
ws.Range("G:G").AutoFilter 1, Arr, xlFilterValues

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

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

End Sub
0 голосов
/ 18 апреля 2019

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

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...