Найти и удалить строку с несколькими критериями - PullRequest
1 голос
/ 31 октября 2019

У меня есть список записей о студентах, перечисленных с фамилией в столбце B и именем в столбце C. В пользовательской форме есть функция поиска, которая вводит имя студента в значения surname.value и firstname.value, тогда яхочу кнопку команды, чтобы найти этого человека в списке записей и удалить всю строку. У меня была эта кодировка, работающая с окнами сообщений, затем я изменил окно сообщений, чтобы удалить строку, и теперь она не работает.

Private Sub CommandButton1_Click()

Dim ws As Worksheet
Set ws = Worksheets("-student records no CVI")


     Dim rngFound As Range
    Dim strFirst As String
    Dim strID As String
    Dim strDay As String

    strID = Surname.Value
    strDay = Firstname.Value

    Set rngFound = Columns("B").Find(strID, Cells(Rows.Count, "B"), xlValues, xlWhole)
    If Not rngFound Is Nothing Then
        strFirst = rngFound.Address
        Do
            If LCase(Cells(rngFound.row, "C").Text) = LCase(strDay) Then
                'Found a match
                ws.Rows(rngFound.row).EntireRow.Delete

            End If
            Set rngFound = Columns("B").Find(strID, rngFound, xlValues, xlWhole)
        Loop While rngFound.Address <> strFirst
    End If

    Set rngFound = Nothing

End Sub

Ответы [ 2 ]

3 голосов
/ 31 октября 2019

Простой способ удаления записей с использованием Autofilter:

Sub Remove_Student()
Dim Ws As Worksheet
Dim strID As String
Dim strDay As String

Set Ws = ThisWorkbook.Sheets("Sheet1")
strID = Surname.Value
strDay = Firstname.Value

Ws.AutoFilterMode = False
Ws.Range("A1").AutoFilter 2, strID
Ws.Range("A1").AutoFilter 3, strDay
Ws.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Ws.AutoFilterMode = False

End Sub
0 голосов
/ 31 октября 2019

Я ни в коем случае не профессионал, просто к вашему сведению, я не уверен, что это лучший способ сделать это, но это то, как я это сделаю.

Обновление (я действительно говорил, что я не профессионал!):

Второй код ответа сначала будет искать фамилию, затем проверять имя, но будетсопоставьте «John Smith» с «John Smithfalls», поскольку это не означает «точную строку», просто требуется наличие строки. Это также менее эффективно, чем использование «Автофильтр». На основании другого ответа и комментариев я сделал еще один ответ, чтобы обновить его. (Принятые ответы всегда отображаются вверху страницы независимо от голосов).

Использование AutoFilter:

Sub Remove_Student()

Dim wb As Workbook, ws As Worksheet

Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")

Dim SurnameStr As String, GivenNameStr As String
SurnameStr = "Smith"
GivenNameStr = "Joe"

With ws
 .AutoFilterMode = False
 With .Range("A1")
  .AutoFilter field:=2, Criteria1:=SurnameStr
  .AutoFilter field:=3, Criteria1:=GivenNameStr
 End With
 .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
 .AutoFilterMode = False
End With
End Sub

Использование InStr:

Sub Remove_Student()

Dim wb As Workbook, ws As Worksheet

Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")

Dim SurnameStr As String, GivenNameStr As String
SurnameStr = "Smith"
GivenNameStr = "Joe"

Dim lRow
lRow = ws.Cells(Rows.Count, "B").End(xlUp).Row

Dim rcell As Range, rng As Range
Set rng = ws.Range("B1:B" & lRow)

For Each rcell In rng.Cells
 If InStr(1, Range(rcell.Address), SurnameStr, vbTextCompare) <> 0 Then
 'MsgBox SurnameStr & " Found in Row " & rcell.Row
  If InStr(1, Range(rcell.Offset(0, 1).Address), GivenNameStr, vbTextCompare) <> 0 Then
   'rcell.EntireRow.Delete
   MsgBox SurnameStr & " , " & GivenNameStr & " Found in Row " & rcell.Row
  End If
 End If
Next rcell

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...