VBA按指定字符串标记行：现有代码优化需求

以下是针对你提出的两个问题的优化代码，同时整合了数据区域自动获取的逻辑：

Sub CategorizeExpenses()
    Dim wsKeywords As Worksheet
    Dim wsData As Worksheet
    Dim keywordRange As Range
    Dim keywords() As String
    Dim i As Integer
    Dim lastRowKeywords As Long
    Dim lastRowData As Long
    Dim searchRng As Range
    Dim cel As Range
    Dim isMatch As Boolean
    Dim categoryName As String
    
    ' 指定工作表对象（第二个工作表存关键词，第一个工作表存数据，可按需调整）
    Set wsKeywords = ThisWorkbook.Worksheets(2)
    Set wsData = ThisWorkbook.Worksheets(1)
    
    ' 读取关键词区域：A1为类别名称，A2至最后一行是对应关键词
    lastRowKeywords = wsKeywords.Cells(wsKeywords.Rows.Count, "A").End(xlUp).Row
    If lastRowKeywords < 2 Then
        MsgBox "未找到有效关键词，请检查第二个工作表的A列数据"
        Exit Sub
    End If
    categoryName = wsKeywords.Range("A1").Value
    Set keywordRange = wsKeywords.Range("A2:A" & lastRowKeywords)
    
    ' 将关键词批量加载到数组
    ReDim keywords(1 To keywordRange.Rows.Count)
    For i = 1 To keywordRange.Rows.Count
        keywords(i) = keywordRange.Cells(i, 1).Value
    Next i
    
    ' 获取数据区域的最后一行（整合你已实现的逻辑）
    lastRowData = wsData.Cells(wsData.Rows.Count, "I").End(xlUp).Row
    Set searchRng = wsData.Range("I3:I" & lastRowData)
    
    ' 遍历数据单元格，匹配关键词
    For Each cel In searchRng
        isMatch = False
        ' 遍历关键词数组，找到匹配即停止
        For Each key In keywords
            If InStr(1, cel.Value, key, vbTextCompare) > 0 Then
                isMatch = True
                Exit For
            End If
        Next key
        
        ' 写入分类结果
        cel.Offset(0, 3).Value = IIf(isMatch, categoryName, "-")
    Next cel
End Sub

问题1：数组元素遍历的优化 #

• 用For Each key In keywords循环替代硬编码索引，自动遍历数组内所有关键词，无需手动修改food(0)、food(1)这类代码。
• 加入Exit For逻辑，找到第一个匹配的关键词后立即跳出循环，减少不必要的计算，提升运行效率。
• 可选的vbTextCompare参数实现忽略大小写匹配（比如单元格中的"spar"也能匹配关键词"Spar"），如果需要严格区分大小写，移除该参数即可。

问题2：从工作表读取关键词的实现 #

• 直接从第二个工作表读取分类规则：A1单元格存储类别名称（如「餐饮」），A2及以下行存储对应关键词，后续增删关键词只需修改工作表内容，无需改动代码。
• 加入边界判断：如果关键词表A列仅存在类别名称（无具体关键词），会弹出提示避免程序报错。

内容的提问来源于stack exchange，提问作者Martin Herzuba