Как использовать строковый текст в операторах If-else в Excel VBA - PullRequest
0 голосов
/ 02 октября 2019

Я пытаюсь ускорить процесс, когда макрос проверяет диапазон текста в столбце B, чтобы сгруппировать их в столбце C в качестве определенного ключевого слова. Например, если у B2 есть яблоко, он помечает его как фрукт в C2, если у B3 есть лук, он помечает его как овощи в C3. В конце концов, некоторые другие тексты я бы хотел, чтобы они просто отображались как «другие». К сожалению, мне не везет в том, чтобы заставить его работать так, как я хочу.

Sub Categorize()

If Range("B2:B100").text="Apple" then
Range("C2:C100").text="Fruit"

ElseIf Range("B2:B100").text="Banana" Then
Range("C2:C100").text="Fruit"

ElseIf Range("B2:B100").text="Onion" Then
Range("C2:C100").text="Vegetable"

Else
Range("C2:C100")="Other"

End If
End Sub

Можете ли вы, ребята, помочь мне?

Ответы [ 2 ]

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

Это должно делать то, что вы хотите. Следите за проблемами с заглавными буквами или просто заставьте все быть прописными / строчными.

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"")"
1 голос
/ 02 октября 2019

Если вам важна скорость, воспользуйтесь формулой Excel. enter image description here

Если вы хотите использовать VBA, вы можете использовать FormulaR1C1 свойство Range объекта.

Range("D2:D200").FormulaR1C1 = "=iferror(vlookup(rc2,c7:c8,2,false),""other"")"

enter image description here

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