Это должно делать то, что вы хотите. Следите за проблемами с заглавными буквами или просто заставьте все быть прописными / строчными.
Sub Categorize()
Dim aCell As Range
Const theColumnToWriteTo As Long = 4 'column d
For Each aCell In Range("b2:b100").Cells
If aCell.Value2 = "Apple" Then
aCell.Worksheet.Cells(aCell.Row, theColumnToWriteTo).Value = "Fruit"
ElseIf aCell.Value2 = "Banana" Then
aCell.Worksheet.Cells(aCell.Row, theColumnToWriteTo).Value = "Fruit"
ElseIf aCell.Value2 = "Onion" Then
aCell.Worksheet.Cells(aCell.Row, theColumnToWriteTo).Value = "Vegetable"
Else
aCell.Worksheet.Cells(aCell.Row, theColumnToWriteTo).Value = "other"
End If
Next aCell
End Sub
ОБНОВЛЕНИЕ Вот альтернативный подход, который является более сложным, но является более эффективным ина самом деле это " правильный " способ сделать такие действия. В результате ваша рабочая таблица изменяется только один раз, что может иметь огромное значение при выполнении тысяч ячеек в рабочей таблице с формулами повсюду.
Вы можете изменить параметры Const
.
Sub getArays()
Const pullRangeAddress As String = "B2:B100"
Const destinationAddress As String = "C2"
Dim WS As Worksheet: Set WS = ActiveSheet ' of whatever sheet
Dim tRay(): tRay() = WS.Range(pullRangeAddress).Value2
'create new blank array to hold values
ReDim nRay(LBound(tRay, 1) To UBound(tRay, 1), LBound(tRay, 2) To UBound(tRay, 2))
Dim x As Long, y As Long
For x = LBound(tRay, 1) To UBound(tRay, 1)
For y = LBound(tRay, 2) To UBound(tRay, 2)
If tRay(x, y) = "Banana" Then
nRay(x, y) = "Fruit"
ElseIf tRay(x, y) = "Apple" Then
nRay(x, y) = "Fruit"
ElseIf tRay(x, y) = "Onion" Then
nRay(x, y) = "Vegetable"
Else
nRay(x, y) = "Other"
End If
Next y
Next x
WS.Range(destinationAddress).Resize(UBound(nRay, 1), UBound(nRay, 2)) = nRay
End Sub
Обновлено снова, пытаясь удержать всех в комментариях Happy
Вы можете использовать оператор select, который немного проще визуализировать.
For x = LBound(tRay, 1) To UBound(tRay, 1)
For y = LBound(tRay, 2) To UBound(tRay, 2)
Select Case tRay(x, y)
Case "Banana", "Apple", "Grapes"
nRay(x, y) = "Fruit"
Case "Onion"
nRay(x, y) = "Vegetable"
Case "Mushrooms", "Weed"
nRay(x, y) = "illegal"
Case Else
nRay(x, y) = "Other"
End Select
Next y
Next x
Добавление еще одного параметра, который использует новую функцию Excel IFS ... Другой ответ имеет хорошую идею просто использовать формулу. Мне нравится концепция, но столбец помощника не допускается !
Range("D2:D200").FormulaR1C1 _
"=IFS(OR(RC[-1]=""Apple"",RC[-1]=""Banana""),""Fruit"",RC[-1]=""Onion"",""Vegetable"",TRUE,""Other"")"