Excel VBA 合并多份分号分隔CSV并按列筛选问题求助

• 变量ThisSheet未定义赋值，计算目标表最后一行的逻辑完全失效
• 复制范围错误：现有代码只读取了源CSV的最后一行，没有覆盖所有有效行
• 未指定CSV分隔符：分号分隔的CSV直接用Workbooks.Open打开时，若系统默认分隔符为逗号，会把所有数据挤在A列，无法正常读取列数据

已经实现按Résultat列筛选、分号格式CSV读取、结果按要求保存的全逻辑：

Option Explicit

Sub 合并筛选CSV()
    Dim folder_path As String, my_file As String
    Dim target_workbook As Workbook
    Dim src_sheet As Worksheet, dest_sheet As Worksheet
    Dim last_row_dest As Long, last_row_src As Long
    Dim col_count As Long, result_col As Long
    Dim i As Long, has_header As Boolean
    Dim filter_condition As String ' 定义Résultat列的筛选条件
    
    ' 配置参数，可根据需求修改
    folder_path = "C:\blabla\" ' 注意路径末尾加反斜杠
    filter_condition = "OK" ' 此处修改为你需要的筛选条件，比如"合格"、">10"等
    has_header = False ' 标记是否已经复制过表头
    
    ' 初始化目标表
    Set dest_sheet = ThisWorkbook.Sheets(1)
    dest_sheet.Cells.Clear ' 清空原有数据
    
    ' 遍历文件夹下所有CSV文件
    my_file = Dir(folder_path & "*.csv")
    Do While my_file <> vbNullString
        ' 用分号作为分隔符打开CSV，避免列错位
        Workbooks.OpenText Filename:=folder_path & my_file, _
            DataType:=xlDelimited, Semicolon:=True, Comma:=False
        Set target_workbook = ActiveWorkbook
        Set src_sheet = target_workbook.Sheets(1)
        
        last_row_src = src_sheet.UsedRange.Rows.Count
        col_count = src_sheet.UsedRange.Columns.Count
        
        ' 查找Résultat列的位置
        result_col = 0
        For i = 1 To col_count
            If src_sheet.Cells(1, i).Value = "Résultat" Then
                result_col = i
                Exit For
            End If
        Next i
        ' 如果没找到对应列，跳过当前文件
        If result_col = 0 Then
            target_workbook.Close False
            my_file = Dir()
            GoTo next_file
        End If
        
        ' 计算目标表最后一行
        last_row_dest = dest_sheet.Cells(dest_sheet.Rows.Count, "A").End(xlUp).Row + 1
        
        ' 第一次复制先带表头
        If has_header = False Then
            src_sheet.Range(src_sheet.Cells(1, 1), src_sheet.Cells(1, col_count)).Copy _
                Destination:=dest_sheet.Cells(last_row_dest, "A")
            last_row_dest = last_row_dest + 1
            has_header = True
        End If
        
        ' 遍历源文件行，筛选符合条件的行复制
        For i = 2 To last_row_src ' 跳过表头行
            If src_sheet.Cells(i, result_col).Value = filter_condition Then
                src_sheet.Range(src_sheet.Cells(i, 1), src_sheet.Cells(i, col_count)).Copy _
                    Destination:=dest_sheet.Cells(last_row_dest, "A")
                last_row_dest = last_row_dest + 1
            End If
        Next i
        
        target_workbook.Close False
next_file:
        my_file = Dir()
    Loop
    
    ' 保存结果为分号分隔的CSV
    dest_sheet.SaveAs Filename:=folder_path & "合并结果.csv", _
        FileFormat:=xlCSV, Local:=True
    
    MsgBox "合并筛选完成，结果已保存至：" & folder_path & "合并结果.csv"
End Sub

• 可以修改filter_condition变量的值，匹配你需要的Résultat列筛选规则
• 若不需要保留表头，删除对应表头复制的逻辑即可
• 可以修改SaveAs的路径和文件名，调整结果文件的保存位置

内容的提问来源于stack exchange，提问作者Benoît S