Excel VBA使用For循环填充列末尾空行构建原料供应商分类表问题求助

代码核心错误点 #

• 读取数据源范围时未指定工作表，默认读取当前激活的工作表而非Sheet3，容易出现数据读取错误
• 严重逻辑错位：将全局去重供应商集合arrS的下标X直接作为Sheet3的行偏移量使用，集合下标和数据源行号完全不对应，匹配逻辑完全失效
• 计算目标列最后一行时列号错误：写入目标列为i+1，但计算空行时取的是第i列的最后一行，导致每列最多只能写入1条数据
• arrS做了全局供应商去重，若同一供应商属于多个分类，会导致后续分类无法匹配到该供应商
• 未重置错误捕获状态，On Error Resume Next执行后没有恢复正常错误提示，不利于调试

修正后代码 #

Sub uniquevalues()
    Application.EnableEvents = False
    Dim arrCategory As New Collection, a
    Dim lRowSource As Long, i As Long, j As Long, lRowTarget As Long
    Dim wsSource As Worksheet, wsTarget As Worksheet
    
    ' 绑定工作表对象，避免活动表误读
    Set wsSource = Sheet3
    Set wsTarget = Sheet12
    
    ' 获取Sheet3原材料分类列的有效数据最后一行，避免遍历空行
    lRowSource = wsSource.Cells(wsSource.Rows.Count, "D").End(xlUp).Row
    
    ' 收集唯一原材料分类
    On Error Resume Next
    For i = 4 To lRowSource
        arrCategory.Add wsSource.Cells(i, "D").Value, CStr(wsSource.Cells(i, "D").Value)
    Next
    On Error GoTo 0 ' 重置错误捕获
    
    ' 清空目标区域旧数据
    wsTarget.Range("B1:Z1000").ClearContents
    
    ' 遍历分类写入表头并匹配对应供应商
    For i = 1 To arrCategory.Count
        ' 写入分类作为列标题
        wsTarget.Cells(1, i + 1) = arrCategory(i)
        ' 遍历所有数据源行，匹配当前分类的供应商
        For j = 4 To lRowSource
            If wsSource.Cells(j, "D").Value = arrCategory(i) Then
                ' 计算当前目标列的第一个空行行号
                lRowTarget = wsTarget.Cells(wsTarget.Rows.Count, i + 1).End(xlUp).Row + 1
                ' 写入供应商名称
                wsTarget.Cells(lRowTarget, i + 1) = wsSource.Cells(j, "C").Value
            End If
        Next
    Next
    
    Application.EnableEvents = True
End Sub

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