Excel IF 语句限制

Question

我在 Excel 中使用 IF 语句来搜索前一列中的部分文本，以便为费用指定供应商和类别。

供应商专栏

=IF(ISNUMBER(SEARCH("tit",[@Description])),"TITAN",IF(ISNUMBER(SEARCH("Sol",[@Description])),"Soltrack",IF(ISNUMBER(SEARCH("coin",[@Description])),"Coin",IF(ISNUMBER(SEARCH("gree",[@Description])),"Green Dream Projects",IF(ISNUMBER(SEARCH("sars V",[@Description])),"SARS VAT",IF(ISNUMBER(SEARCH("sars p",[@Description])),"SARS PAYE",IF(ISNUMBER(SEARCH("acb",[@Description])),"Debit Order","")))))))

类别列

然后下一列有以下内容以获取供应商的类别

=IF(ISNUMBER(SEARCH("TITAN",[@Payee])),"Direct Operating Cost",IF(ISNUMBER(SEARCH("Soltrack",[@Payee])),"Direct Operating Cost",IF(ISNUMBER(SEARCH("Coin",[@Payee])),"Direct Operating Cost",IF(ISNUMBER(SEARCH("Green Dream Projects",[@Payee])),"Direct Operating Cost",IF(ISNUMBER(SEARCH("SARS VAT",[@Payee])),"VAT",IF(ISNUMBER(SEARCH("SARS PAYE",[@Payee])),"PAYE",IF(ISNUMBER(SEARCH("Debit Order",[@Payee])),"Debit Order","")))))))

效果很好，但似乎我已经达到了可以在一个公式中使用的 IF 语句的限制 (7)？

我创建了以下函数来搜索文本“tit”，如果匹配则更新收款人列。

'excel if range of cells contains specific text vba
Sub MacroToCheckIfRangeOfCellsContainsSpecificText_vba()

Set Rng = Range("B2:B572") ' You can change this
specificText = "*tit*" ' You can change this


 For Each Cell In Rng.Cells
 
 If UCase(Cell.Value) Like "*" & UCase(specificText) & "*" Then
 Cell.Offset(0, 1) = "Titan"
 Else
 Cell.Offset(0, 1) = ""
 End If
 Next
 
End Sub

我是否需要为每个关键字创建一个新的 specificText = "*tit*" 并为每个“For Each”函数创建一个完整的部分？

Answer 1

字典解决方案

第一个想法是使用字典 Replacements 并在其中添加所有 serach/replace 对。这有一个很大的缺点。不混合逻辑（代码）和数据是违反良好做法的。好的做法是不将数据放入代码中，而是放入工作表中（参见下一个解决方案）。

Option Explicit

Public Sub MacroToCheckIfRangeOfCellsContainsSpecificText_vba()
    Dim RngToCheck As Range
    Set RngToCheck = ThisWorkbook.Worksheets("Sheet1").Range("B2:B572") ' specify in which workbook and worksheet
    
    Dim Replacements As Object
    Set Replacements = CreateObject("Scripting.Dictionary")
    
    With Replacements
        .Add "tit", "Titan"
        .Add "sol", "Soltrack"
        'add more here
    End With
    
    Dim InputValues() As Variant
    InputValues = RngToCheck.Value 'read input values into array
    
    Dim OutputValues() As Variant 'create an output array (same size as RngToCheck)
    ReDim OutputValues(1 To RngToCheck.Rows.Count, 1 To 1)
    
    Dim iRow As Long
    For iRow = 1 To UBound(OutputValues, 1)
        Dim Key As Variant
        For Each Key In Replacements.Keys
            If UCase(InputValues(iRow, 1)) Like "*" & UCase(Key) & "*" Then
                OutputValues(iRow, 1) = Replacements(Key)
                Exit For 'we don't need to test for the others if we found a key
            End If
        Next Key
    Next iRow
    
    'write output values from array next to input values in the cells
    RngToCheck.Offset(ColumnOffset:=1).Value = OutputValues
End Sub

工作表解决方案

更好的解决方案是创建一个新的工作表 Replacements，如下所示：

这可以由任何人轻松编辑，如果您想删除或添加对，您以后不需要 fiddle 使用代码。

Public Sub ImprovedCheckUsingWorksheet()
    Dim RngToCheck As Range
    Set RngToCheck = ThisWorkbook.Worksheets("Sheet1").Range("B2:B572") ' specify in which workbook and worksheet
    
    Dim Replacements() As Variant 'read replacements from worksheet
    Replacements = ThisWorkbook.Worksheets("Replacements").Range("A2", ThisWorkbook.Worksheets("Replacements").Cells(Rows.Count, "B").End(xlUp)).Value 'read input values into array
    
    
    Dim InputValues() As Variant
    InputValues = RngToCheck.Value 'read input values into array
    
    Dim OutputValues() As Variant 'create an output array (same size as RngToCheck)
    ReDim OutputValues(1 To RngToCheck.Rows.Count, 1 To 1)
    
    Dim iRow As Long
    For iRow = 1 To UBound(OutputValues, 1)
        Dim rRow As Long
        For rRow = 1 To UBound(Replacements, 1)
            If UCase(InputValues(iRow, 1)) Like "*" & UCase(Replacements(rRow, 1)) & "*" Then
                OutputValues(iRow, 1) = Replacements(rRow, 2)
                Exit For 'we don't need to test for the others if we found a key
            End If
        Next rRow
    Next iRow
    
    'write output values from array next to input values in the cells
    RngToCheck.Offset(ColumnOffset:=1).Value = OutputValues
End Sub

对于替换工作表中的 3ʳᵈ 列，您需要将以下行调整为直到列 "C":

Replacements = ThisWorkbook.Worksheets("Replacements").Range("A2", ThisWorkbook.Worksheets("Replacements").Cells(Rows.Count, "C").End(xlUp)).Value 'read input values into array

并且输出值也需要另一列（第二个参数需要 1 To 2）：

ReDim OutputValues(1 To RngToCheck.Rows.Count, 1 To UBound(Replacements, 2) - 1) 'this works for any amount of columns as it reads the column count from the `Replacements`

需要写入数据

OutputValues(iRow, 1) = Replacements(rRow, 2) 'first output column
OutputValues(iRow, 2) = Replacements(rRow, 3) 'second output column

写入输出值也需要调整：

RngToCheck.Offset(ColumnOffset:=1).Resize(ColumnSize:=UBound(OutputValues, 2)).Value = OutputValues 'this works for any amount of columns as it reads the column count from `OutputValues`

公式解

但是，如果您的数据位于上述工作表 Replacements 中，并且您不依赖于部分匹配。那么您就不需要 VBA 并且可以轻松地使用公式来查找它：

=IFERROR(INDEX(Replacements!B:B,MATCH(B:B,Replacements!A:A,0)),"")

Excel IF 语句限制

Excel IF Statement Limited

excel

vba

if-statement

office365

字典解决方案

工作表解决方案

公式解