Удаление строк на основе повторяющихся ячеек и содержимого второго столбца (VBA)

У меня есть некоторые проблемы с удалением повторяющихся строк, так как способ, которым я должен это сделать, довольно сложен. Позвольте мне объяснить.

Вот что у меня есть (на самом деле у меня более 90 000 строк!)

+-----------+------------------+

|    Ref    |       Sup        |

+-----------+------------------+

| 10000-001 | S_LA_LLZ_INOR    |

| 10000-001 | S_LA_RADAR_STNFN |

| 10000-001 | S_LA_VOR_LRO     |

| 10000-001 | S_LA_DME_LRO     |

| 10000-001 | S_LA_DME_INOR    |

| 1000-001  | S_LA_GP_INOR     |

| 1000-001  | S_LA_LLZ_ITF     |

| 1000-001  | S_ZS_LLZ_ITF     |

| 1000-002  | S_LA_GP_INOR     |

| 1000-002  | S_LA_LLZ_ITF     |

+-----------+------------------+

Что мне нужно сделать, так это поиск дубликатов в столбце А. Затем я должен проверить в столбце B, совпадают ли цепочки символов после S_LA_ или S_ZS_. Если они одинаковы. Я должен удалить строку с S_LA_

Итак, в строках выше я должен был бы удалить строку с 1000-001|S_LA_LLZ_ITF.

Я написал код. Это работает, но это болезненно медленно при работе с 10 000 + строк.

Dim LastRowcheck As Long

Dim str1 As String

Dim str2 As String

Dim str3 As String

Dim str4 As String

Dim str5 As String

Dim str6 As String

Dim prueba As Integer

Dim prueba1 As Integer

Dim n1 As Long

Dim n3 As Long

Dim colNum As Integer

Dim colNum1 As Integer

Dim iCntr As Long



colNum = WorksheetFunction.Match("Ref", ActiveSheet.Range("1:1"), 0)

colNum1 = WorksheetFunction.Match("Sup",ActiveSheet.Range("1:1"), 0)



With ActiveSheet

  LastRowcheck = .Range("A" & .Rows.Count).End(xlUp).Row

  For n1 = 2 To LastRowcheck

      str1 = Cells(n1, colNum).Value

      For n3 = n1 + 1 To LastRowcheck + 1

          str2 = Cells(n3, colNum).Value

          prueba = StrComp(num1, num2)

          If prueba = 0 Then

              str3 = Cells(n1, colNum1).Value

              str4 = Cells(n3, colNum1).Value

              str5 = Right(str3, Len(str3) - 5)

              str6 = Right(str4, Len(str4) - 5)

              prueba1 = StrComp(str5, str6)

                  If prueba1 = 0 Then

                      If StrComp(num3, num4) = 1 Then

                          Cells(n3, colNum).Interior.ColorIndex = 3

                      ElseIf StrComp(num3, num4) = -1 Then

                          Cells(n1, colNum).Interior.ColorIndex = 3

                      End If

                  End If

              End If

          Next n3

      Next n1



  For iCntr = LastRowcheck To 2 Step -1

      If Cells(iCntr, colNum).Interior.ColorIndex = 3 Then

          Rows(iCntr).Delete

      End If

  Next iCntr

End With