如何简化VBA中条件与执行语句模式重复的if-statement

针对你遇到的重复If-ElseIf语句冗余问题，核心思路是建立水果名称与输出列索引的映射关系，避免逐行判断的低效代码。以下是三种实用优化方案：

方案1：使用字典（Dictionary）映射（推荐） #

字典查找效率极高，适合数据量较大的场景，代码简洁易维护。

Dim d As Integer
Dim k As Integer
Dim range_output As Range
Dim lRow As Long
Dim osh As Worksheet
Dim sh1 As Worksheet
Dim fruitDict As Object

' 初始化工作表对象（原代码遗漏sh1的Set，需补充）
Set osh = ThisWorkbook.Worksheets("Original")
Set sh1 = ThisWorkbook.Worksheets("输出表") ' 替换为你的输出工作表名称
Set range_output = sh1.Range("C8:J38")
Set fruitDict = CreateObject("Scripting.Dictionary")

' 方式A：手动添加水果-输出列映射
fruitDict("APPLE") = 1
fruitDict("ORANGE") = 2
fruitDict("GRAPE") = 3
fruitDict("LEMON") = 4
' 可继续添加更多水果映射

' 方式B：从工作表区域批量加载映射（推荐，便于后续修改）
' 假设data表的"fruit"区域是两列：A列存水果名称，B列存对应输出列号
' Dim fruitRange As Range
' Set fruitRange = ThisWorkbook.Worksheets("data").Range("fruit")
' Dim i As Integer
' For i = 1 To fruitRange.Rows.Count
'     fruitDict(fruitRange.Cells(i, 1).Value) = fruitRange.Cells(i, 2).Value
' Next i

lRow = osh.Range("C" & Rows.Count).End(xlUp).Row
For d = 1 To lRow
    Dim currentFruit As String
    currentFruit = osh.Cells(d, 3).Value
    
    ' 检查当前水果是否在映射中，存在则执行赋值
    If fruitDict.Exists(currentFruit) Then
        k = Day(osh.Cells(d, 1).Value)
        range_output.Cells(k, fruitDict(currentFruit)).Value = osh.Cells(d, 9).Value
    End If
Next d

方案2：数组循环匹配 #

无需依赖外部对象，兼容性强，适合数据量较小的场景。

Dim d As Integer
Dim k As Integer
Dim range_output As Range
Dim lRow As Long
Dim osh As Worksheet
Dim sh1 As Worksheet
Dim fruitArr As Variant
Dim matchIndex As Integer
Dim i As Integer

Set osh = ThisWorkbook.Worksheets("Original")
Set sh1 = ThisWorkbook.Worksheets("输出表")
Set range_output = sh1.Range("C8:J38")

' 从data表加载水果数组（单列，数组行号对应输出列号）
fruitArr = ThisWorkbook.Worksheets("data").Range("fruit").Value

lRow = osh.Range("C" & Rows.Count).End(xlUp).Row
For d = 1 To lRow
    currentFruit = osh.Cells(d, 3).Value
    matchIndex = 0
    
    ' 循环数组查找匹配的水果
    For i = LBound(fruitArr, 1) To UBound(fruitArr, 1)
        If fruitArr(i, 1) = currentFruit Then
            matchIndex = i
            Exit For ' 找到匹配项后立即退出循环，提升效率
        End If
    Next i
    
    ' 匹配成功则执行赋值
    If matchIndex > 0 Then
        k = Day(osh.Cells(d, 1).Value)
        range_output.Cells(k, matchIndex).Value = osh.Cells(d, 9).Value
    End If
Next d

方案3：使用Excel内置Match函数 #

代码最简洁，利用Excel的查找功能，需注意错误处理。

Dim d As Integer
Dim k As Integer
Dim range_output As Range
Dim lRow As Long
Dim osh As Worksheet
Dim sh1 As Worksheet
Dim fruitRange As Range
Dim matchIndex As Integer

Set osh = ThisWorkbook.Worksheets("Original")
Set sh1 = ThisWorkbook.Worksheets("输出表")
Set range_output = sh1.Range("C8:J38")
Set fruitRange = ThisWorkbook.Worksheets("data").Range("fruit")

lRow = osh.Range("C" & Rows.Count).End(xlUp).Row
For d = 1 To lRow
    currentFruit = osh.Cells(d, 3).Value
    
    ' 用Match查找水果在区域中的位置，处理找不到的情况
    On Error Resume Next
    matchIndex = WorksheetFunction.Match(currentFruit, fruitRange, 0)
    On Error GoTo 0
    
    If matchIndex > 0 Then
        k = Day(osh.Cells(d, 1).Value)
        range_output.Cells(k, matchIndex).Value = osh.Cells(d, 9).Value
    End If
Next d

方案对比 #

• 字典：查找速度最快，适合大数据量，易扩展维护。
• 数组循环：无外部依赖，兼容性好，小数据量场景足够高效。
• Match函数：代码最简洁，依赖Excel内置函数，需处理匹配失败的错误。

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