Создание динамического селектора c Excel

Question

У меня есть некоторый макрос, который присваивает категории различным строкам на основе ключевых слов. Это работает хорошо, но тяжело на машине, так как использует всю колонку. Как я могу установить его так, чтобы он просто искал эти слова до последней записи в столбце A: A?

Sub Categorise()
    Sheets("Data").Range("I:I") = "=IF(OR(ISNUMBER(SEARCH(""*chair fault*"",B:B)),ISNUMBER(SEARCH(""*Chair noise*"",B:B))), ""Seating"", """")"
    Sheets("Data").Range("L:L") = "=IF(OR(ISNUMBER(SEARCH(""*Arm fail*"",B:B)),ISNUMBER(SEARCH(""*Arm inhibition*"",B:B)),ISNUMBER(SEARCH(""*Gap in Arm*"",B:B)),ISNUMBER(SEARCH(""*No Arms*"",B:B)),ISNUMBER(SEARCH(""*All Arms*"",B:B))), ""Angles"", """")"
    Sheets("Data").Range("M:M") = "=IF(OR(ISNUMBER(SEARCH(""*Couch*"",B:B)),ISNUMBER(SEARCH(""*Heating*"",B:B))), ""Comfort"", """")"  
    Sheets("Data").Range("J:J") = "=IF(OR(ISNUMBER(SEARCH(""*UDCD*"",B:B)),ISNUMBER(SEARCH(""*HDD flats*"",B:B)),ISNUMBER(SEARCH(""*HDD runner*"",B:B))), ""Runners"", """")" 
    Sheets("Data").Range("K:K") = "=IF(ISNUMBER(SEARCH(""*Cabbies*"",B:B)),""Cabbies four"","""")"
    Sheets("Data").Range("N:N") = "=IF(ISNUMBER(SEARCH(""*Braker*"",B:B)),""Elec"","""")"
    Sheets("Data").Range("O:O") = "=IF(OR(ISNUMBER(SEARCH(""*Camera*"",B:B)),ISNUMBER(SEARCH(""*chough*"",B:B)),ISNUMBER(SEARCH(""*Master MCC*"",B:B)),ISNUMBER(SEARCH(""*Standards*"",B:B)),ISNUMBER(SEARCH(""*screen*"",B:B)),ISNUMBER(SEARCH(""*RTSS*"",B:B)),ISNUMBER(SEARCH(""*Heads*"",B:B)),ISNUMBER(SEARCH(""*Harps faulty*"",B:B)),ISNUMBER(SEARCH(""*TMSC*"",B:B)),ISNUMBER(SEARCH(""*Blind*"",B:B))), ""Blinders"", """")" 
    Sheets("Data").Range("P:P") = "=IF(OR(ISNUMBER(SEARCH(""*faulting*"",B:B)),ISNUMBER(SEARCH(""*Marker MN*"",B:B)),ISNUMBER(SEARCH(""*Elec M5*"",B:B)),ISNUMBER(SEARCH(""* Alarm*"",B:B)),ISNUMBER(SEARCH(""*Graber*"",B:B)),ISNUMBER(SEARCH(""*catcher*"",B:B)),ISNUMBER(SEARCH(""*Circuit*"",B:B)),ISNUMBER(SEARCH(""*Sal fault*"",B:B)),ISNUMBER(SEARCH(""*Panter*"",B:B)),ISNUMBER(SEARCH(""*Vigilance*"",B:B))), ""Misc"", """")"
    Sheets("Data").Range("F:F") = "=I:I&J:J&K:K&L:L&M:M&N:N&O:O&P:P"
    Sheets("Data").Columns("I:P").EntireColumn.Hidden = True
    Sheets("Data").Range("F1").FormulaR1C1 = "System"
End Sub

Answer 1

Вы можете использовать возможности vba для построения формул и избавить вас от необходимости набирать так много. Ваш вопрос задан в столбце A, но в вашем коде показан столбец B. Я использовал столбец B,

 Sub Categorise()

   Dim wsData As Worksheet, lastrow As Long
   Set wsData = ThisWorkbook.Sheets(1)

   With wsData
     lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
   End With

   Dim ar(8), isN() As String
   ar(0) = Array("Seating", "chair fault", "chair noise")
   ar(1) = Array("Angles", "Arm fail", "arm inhibition", "Gap in Arm", "No Arms", "All Arms")
   ar(2) = Array("Comfort", "Couch", "Heating")
   ar(3) = Array("Runners", "UDCD", "HDD flats", "HDD runner")
   ar(4) = Array("Cabbies four", "Cabbies")
   ar(5) = Array("Elec", "Braker")
   ar(6) = Array("Blinders", "camera", "chough", "Master MCC", "Standards", "screen", _
   "RTSS", "Heads", "Harps faulty", "TMSC", "Blind")
   ar(7) = Array("Misc", "faulting", "Marker MN", "Elec M5", "Alarm", _
   "Grabber", "catcher", "Circuit", "Sal fault", "panter", "Vigilance")

   With wsData
     .Range("I1:I" & lastrow) = Query(ar(0))
     .Range("L1:L" & lastrow) = Query(ar(1))
     .Range("M1:M" & lastrow) = Query(ar(2))
     .Range("J1:J" & lastrow) = Query(ar(3))
     .Range("K1:K" & lastrow) = Query(ar(4))
     .Range("N1:N" & lastrow) = Query(ar(5))
     .Range("O1:O" & lastrow) = Query(ar(6))
     .Range("P1:P" & lastrow) = Query(ar(7))
     .Range("F1:F" & lastrow) = "=I:I&J:J&K:K&L:L&M:M&N:N&O:O&P:P"
     .Columns("I:P").EntireColumn.Hidden = True
     .Range("F1").FormulaR1C1 = "System"
   End With
   MsgBox "Done"

 End Sub

 Function Query(ar) As String

   Dim isN() As String, i As Integer
   ReDim isN(UBound(ar) - 1)
   For i = 1 To UBound(ar)
     isN(i - 1) = "ISNUMBER(SEARCH(""*" & ar(i) & "*"",B:B))"
   Next
   If UBound(ar) > 1 Then
     Query = "=IF(OR(" & Join(isN, ",") & "), """ & ar(0) & ""","""")"
   Else
     Query = "=IF(" & isN(0) & ", """ & ar(0) & ""","""")"
   End If
   Debug.Print Query

 End Function