Excel VBA需求：按唯一供应商值筛选数据并逐一复制

数据老陈

2026-5-29

嗨，我来帮你搞定这个VBA宏的问题！根据你的需求，我们可以通过提取唯一供应商列表+循环筛选复制的思路来实现，下面是具体的方案：

核心思路

先把所有不重复的供应商名称提取出来，避免重复处理同一个供应商
逐个遍历这些唯一供应商，执行筛选、复制对应数据的操作
循环完成所有供应商的处理，自动适配动态的供应商数量

完整VBA代码示例

这段代码可以直接使用，记得根据你的实际工作表名称和数据结构调整：

Sub ProcessVendors()
    Dim ws As Worksheet
    Dim uniqueVendors As Collection
    Dim vendor As Variant
    Dim lastRow As Long
    Dim copyRange As Range
    
    ' 设置要操作的工作表（把"Sheet1"改成你的实际表名）
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set uniqueVendors = New Collection
    
    ' 第一步：提取所有唯一的供应商名称
    On Error Resume Next ' 忽略重复添加时的报错，因为Collection的Key不能重复
    For i = 2 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 假设表头在第1行，数据从第2行开始
        uniqueVendors.Add ws.Cells(i, "A").Value, Key:=CStr(ws.Cells(i, "A").Value)
    Next i
    On Error GoTo 0 ' 恢复正常的错误捕获
    
    ' 第二步：循环处理每个供应商
    For Each vendor In uniqueVendors
        ' 先清除之前的筛选状态
        If ws.AutoFilterMode Then ws.AutoFilterMode = False
        
        ' 筛选当前供应商的数据（Field:=1代表第1列，也就是供应商列）
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        ws.Range("A1:B" & lastRow).AutoFilter Field:=1, Criteria1:=vendor
        
        ' 获取筛选后的可见数据（跳过第1行的表头）
        On Error Resume Next
        Set copyRange = ws.Range("A2:B" & lastRow).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        
        ' 如果筛选到数据，就执行复制（这里替换成你的邮件处理逻辑就行）
        If Not copyRange Is Nothing Then
            copyRange.Copy
            ' --------------------------
            ' 这里插入你的邮件发送代码
            ' 比如粘贴到临时表保存为附件，或者直接插入邮件正文
            ' --------------------------
            MsgBox "已复制供应商 " & vendor & " 的数据，准备发送邮件！" ' 测试提示，实际使用可以删掉
        End If
        
        ' 清除当前筛选，为下一个供应商做准备
        ws.AutoFilterMode = False
    Next vendor
    
    MsgBox "所有供应商都处理完啦！"
End Sub

关键细节说明

提取唯一供应商：用Collection存储供应商名称，利用它的Key属性自动去重，On Error Resume Next是为了避免重复添加同一个供应商时触发报错
筛选操作：AutoFilter方法是Excel VBA里做筛选的标准方式，Field:=1对应你的供应商列（A列），如果你的供应商在其他列，修改这个数字即可
获取可见区域：SpecialCells(xlCellTypeVisible)能精准拿到筛选后的有效数据，加On Error Resume Next是防止某个供应商没有数据时触发错误
循环逻辑：遍历Collection里的每个供应商，不管有多少个供应商都能自动处理

注意事项

确认你的数据表头在第1行，供应商列是A列，数据从第2行开始，如果结构不一样，调整代码里的行列号即可
复制后的邮件处理部分，你可以完全替换成自己的代码，比如把复制的数据粘贴到新工作表，保存为Excel文件作为邮件附件发送
测试前记得备份你的数据，避免误操作

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