Question

我有一些VBA代码正在工作，但想知道是否有更简单的方法对此进行编码。我有一个包含100个唯一值的列表，想为每个值分配一个类别，并将类别名称写在另一个单元格中

我有一条有效的if-else语句，它检查每个值并输出一个类别。

Sub AssignCategory()
Dim rng As Range
Set rng = ActiveSheet.Range("A2:A100")
For Each cell In rng.Cells
    If InStr(1, cell, "Apple") Then
        cell.Offset(0, 2).Value = "Fruit"
    ElseIf InStr(1, cell, "Racoon") Then
        cell.Offset(0, 2).Value = "Animal"
    ElseIf InStr(1, cell, "Lion") Then
        cell.Offset(0, 2).Value = "Animal"
    ElseIf InStr(1, cell, "Quartz") Then
        cell.Offset(0, 2).Value = "Mineral"
    ElseIf InStr(1, cell, "Watermelon") Then
        cell.Offset(0, 2).Value = "Fruit"
    End If
Next
End Sub

该代码正在运行，但是我可以列出例如Animals的所有单元格，并将类别Animal分配给所有这些单元格吗？而不是拥有100条单独的语句。

Answer 1

您可以尝试选择...案例 microsoft

Answer 2

Select Case语句将使您可以将多个选项堆叠到一个结果中。

Sub AssignCategory()

    Dim rng As Range
    Set rng = ActiveSheet.Range("A2:A100")
    For Each cell In rng.Cells

        Select Case lcase(cell.value2)
          case "apple", "orange", "pear", "watermelon"
            cell.Offset(0, 2).Value = "Fruit"
          case "lion", "raccoon"
            cell.Offset(0, 2).Value = "Animal"
          case "quartz"
            cell.Offset(0, 2).Value = "Mineral"
          case else  'no match to anything above
            cell.Offset(0, 2).Value = "no category"
        end select

    Next cell

End Sub

顺便说一句，InStr通常用于在另一个字符串中定位子字符串。从您的描述看来，您似乎想要1：1的直接比较。

Answer 3

对我来说，您可以创建1个excel表作为数据表，然后创建一个函数来读取excel表并像sql一样工作。

请参见下面的示例。确保在引用时您已经添加了Microsoft ActiveX数据对象库

Function getStringValue() As String

Dim cn As ADODB.Connection

Dim rs As ADODB.Recordset


strFile = Workbooks(1).FullName

strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"


Set cn = CreateObject("ADODB.Connection")

Set rs = CreateObject("ADODB.Recordset")


cn.Open strCon

''modify this sql statement as per your requirement

strSQL = "SELECT * FROM [Sheet1$A1:E346] where ID =1" ''Range

rs.Open strSQL, cn

getValue = rs.GetString

End Function

Answer 4

您可以使用类似的方法来检查单元格中是否包含特定文本，如果您有案例列表，那么将更易于维护：

Sub AssignCategory()
    Dim rng As Range
    Dim cell As Range, key
    Set rng = ActiveSheet.[A2:A100]
    Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")

    dic.Add "*apple*", "Fruit"
    dic.Add "*watermelon*", "Fruit"
    dic.Add "*racoon*", "Animal"
    dic.Add "*lion*", "Animal"
    dic.Add "*quartz*", "Mineral"

    For Each cell In rng.Cells
        For Each key In dic
            If LCase(cell) Like key Then
                cell.Offset(, 2).Value = dic(key)
                Exit For
            End If
        Next
    Next
End Sub

如果您需要检查单元格是否等于特定文本，请使用select ... case：

Sub AssignCategory2()
    Dim rng As Range
    Dim cell As Range
    Set rng = ActiveSheet.[A2:A100]

    For Each cell In rng.Cells
        Select Case LCase(cell)
            Case "apple", "watermelon": cell.Offset(, 2).Value = "Fruit"
            Case "racoon", "lion": cell.Offset(, 2).Value = "Animal"
            Case "quartz": cell.Offset(, 2).Value = "Mineral"
        End Select
    Next
End Sub

VBA检查包含特定文本的单元格的最短方法

4 个答案: