嘿，很高兴看到你第一个VBA项目已经跑起来了！重复写多遍几乎一样的循环确实会让代码变得臃肿难读，咱们可以用数组存储工作表和对应属性映射的方式，把这些重复逻辑合并成一套简洁的循环逻辑，既易读又好维护。

核心优化思路 #

把需要处理的每个工作表、它要映射到clsItem的属性名称，以及对应的列号，整理成一个二维数组。然后通过外层循环遍历这个数组，内层循环处理每行数据，一次性完成所有工作表的字典构建和属性赋值。

优化后的完整代码 #

Sub BuildItemDictionary()
    Dim dictName As New Dictionary
    Dim wsProcessingList As Variant
    Dim currentWsData As Variant
    Dim targetRange As Range
    Dim itemObj As clsItem
    Dim rowIndex As Long
    Dim itemId As Long
    
    ' 定义要处理的工作表集合：(工作表对象, 属性名称, 数据列号)
    ' 你可以根据实际业务修改属性名和列号
    wsProcessingList = Array( _
        Array(sheet1, "ItemName", 70), _
        Array(sheet2, "ItemCategory", 2), _
        Array(sheet3, "ItemPrice", 5), _
        Array(sheet4, "ItemStock", 10), _
        Array(sheet5, "ItemSupplier", 15), _
        Array(sheet6, "ItemCreateDate", 20), _
        Array(sheet7, "ItemStatus", 25) _
    )
    
    ' 遍历所有待处理的工作表
    For Each currentWsData In wsProcessingList
        Set targetRange = currentWsData(0).Range("A1").CurrentRegion
        
        ' 遍历当前工作表的行（从第3行开始，和你原逻辑一致）
        For rowIndex = 3 To targetRange.Rows.Count
            itemId = targetRange.Cells(rowIndex, 1).Value
            
            ' 处理字典中ID的存在性：不存在则新建对象，存在则直接复用
            If Not dictName.Exists(itemId) Then
                Set itemObj = New clsItem
                dictName.Add itemId, itemObj
            Else
                Set itemObj = dictName(itemId)
            End If
            
            ' 动态赋值对应属性（这里用Select Case保证可读性，也可以用CallByName简化）
            Select Case currentWsData(1)
                Case "ItemName"
                    itemObj.ItemName = targetRange.Cells(rowIndex, currentWsData(2)).Value
                Case "ItemCategory"
                    itemObj.ItemCategory = targetRange.Cells(rowIndex, currentWsData(2)).Value
                Case "ItemPrice"
                    itemObj.ItemPrice = targetRange.Cells(rowIndex, currentWsData(2)).Value
                Case "ItemStock"
                    itemObj.ItemStock = targetRange.Cells(rowIndex, currentWsData(2)).Value
                Case "ItemSupplier"
                    itemObj.ItemSupplier = targetRange.Cells(rowIndex, currentWsData(2)).Value
                Case "ItemCreateDate"
                    itemObj.ItemCreateDate = targetRange.Cells(rowIndex, currentWsData(2)).Value
                Case "ItemStatus"
                    itemObj.ItemStatus = targetRange.Cells(rowIndex, currentWsData(2)).Value
            End Select
        Next rowIndex
    Next currentWsData
End Sub

关键优化细节 #

• 告别重复变量：不用手动定义rg1到rg7，所有工作表信息集中在数组里，后续新增/修改工作表只需要调整数组即可
• 统一循环逻辑：把7套重复的循环合并成一套嵌套循环，代码量骤减，可读性大幅提升
• 避免字典键冲突：补上了ID存在性判断，解决了原代码后续循环执行Add会报错的问题
• 可扩展性强：如果后续要新增工作表或属性，只需要在数组里加一行，修改Select Case即可

如果你的clsItem属性名和数组里的字符串完全一致，还可以用CallByName简化赋值逻辑，省去Select Case：

' 替换上面的Select Case代码块
CallByName itemObj, currentWsData(1), vbLet, targetRange.Cells(rowIndex, currentWsData(2)).Value

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