批量处理CSV文件数据

• 有CSV文件数据，如下图

源数据

• 数据都只在一个单元格内
• 完整的一条数据分为两个单元格，见标题处。
• 中间还有小计行，如下图

小计行

• 开头是1的特殊数据

1

• 末尾的数据格式，如下图。

末尾

• 最终结果：如下图

结果

• 这样的CSV文件有多个，格式都一样。

---

• 处理方法：

Sub InputCSV110()
    Dim Arr, brr()
    Dim MyName As String
    Dim MyPath As String
    Dim sFType As String
    Dim wkb As Workbook
    Application.ScreenUpdating = False'关闭屏幕刷新
    Application.DisplayAlerts = False'关闭屏幕提示
    ActiveSheet.UsedRange.Offset(1, 0).ClearContents'清空源数据区域
    sFType = "*.csv" '文件类型
    MyPath = ThisWorkbook.Path & "\" '路径
    MyName = Dir(MyPath & sFType)    '返回文件名称
    Do Until MyName = ""  '遍历文件
        Set wkb = Workbooks.Open(MyPath & MyName)'打开CSV文件
        Arr = wkb.ActiveSheet.[a1].CurrentRegion'将数据放进数组arr
        wkb.Close False'关闭CSV文件
'定位有效数据的最后一行,即末尾图片中包含‘小计’的最后单元格，这里除了循环，也可以用find方法定位。
        For i = UBound(Arr) To LBound(Arr) Step -1
            If InStr(Arr(i, 1), "小计") > 0 Then
                x = i - 1
                Exit For
            End If
        Next
        ReDim brr(1 To UBound(Arr), 1 To 16)'定义数组brr装入符合条件的数据
        For i = 11 To x - 1 Step 2'遍历数组元素，提取数据
            If InStr(Arr(i, 1), "小计") = 0 Then'如果数组元素不包含‘小计’的字符,就符合要求，提取数据
                k = k + 1'计数
  '数据分为2行，split分列，数组元素值为空的不要，数组元素为1的（有且只有开头为1）不要
                s = Split(Arr(i, 1), " ") '第一行数据
                For Each p In s
                    If p <> "" And p <> 1 Then
                        n = n + 1
                        brr(k, n) = p
                    End If
                Next
                
                ss = Split(Arr(i + 1, 1), " ") '第二行数据
                For Each pp In ss
                    If pp <> "" And pp <> 1 Then
                        n = n + 1
                        brr(k, n) = pp
                    End If
                Next
                
                n = 0   'n复位
            Else
                i = i - 1'小计行则倒将i-1，回档跳过小计（步长是step 2）
            End If
            
        Next
'循环结束,输出数据
        Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1).Resize(k, 16) = brr
        k = 0
        MyName = Dir'轮到下一个CSV文件
    Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

---

示例文件下载

链接: http://pan.baidu.com/s/1gfve7qN 密码: 397s