Excel的读取与写入

这篇文章是《使用excel完成单一SKU精细化运营数据》的代码重构版本，考虑到上篇写的代码十分冗杂，这次将读取的代码缩短，并且无论有多少行多少列，都可以保证取得所有的数据。另外这次让已经操作的文件移动到另一个文件夹，这样在文件夹上追加数据时，就可以一目了然。

在追加数据的时候，有些代码会重复运行，导致效率的降低，但是如果设计两个按钮，效率有所下降。想在文件中使用vlookup，可惜暂时能力不足，加不进去。这次我将版本命名为 version 0.0.1 ，在以后的日子中，代码会不断的升级。

首先我们来看一下文件目录：

TIM图片20180306233817.png

然后我们来看一下代码，代码里暂时没有什么注释，因此这篇文章权作自己的随笔记录，如果造成麻烦，还请原谅。

Sub dataParse()

    Application.ScreenUpdating = False

    Dim temp, path, sheetsName, sFileName As String
    Dim firstNum, numCount As Integer

    Dim fso As Object
    Dim originalAdd, targetAdd, fileOperated As String

    path = "D:\\Documents\\Desktop\\dataParse\\fileToHandle\\"
    firstNum = 2
    temp = Dir(path & "*.csv")

    targetAdd = "D:\Documents\Desktop\dataParse\fileOperated\"
    originalAdd = "D:\Documents\Desktop\dataParse\fileToHandle\"
    fileOperated = temp

    ' 处理表头，并且加入日期
    Set wb = Workbooks.Open(path & temp)
    sheetsName = ActiveSheet.Name
    wb.Sheets(sheetsName).Range("a1", Range("a1").End(xlToRight)).Copy _
        ThisWorkbook.Sheets("Sheet1").Range("B1")
    ThisWorkbook.Sheets("sheet1").Range("a1") = "日期"
    wb.Close False

    Do While temp <> ""
        If temp = "" Then
            Exit Do
        End If

        Set wb = Workbooks.Open(path & temp)
        sheetsName = ActiveSheet.Name
        Set myRange = wb.Sheets(sheetsName).Range("B:B")
        numCount = Application.WorksheetFunction.CountA(myRange)
        
        ' 将打开的csv文件中的数据，复制到目标地区
        ' 从底开始找，再向下偏移一个单元格
        With wb
            .Sheets(sheetsName).Range("a2", Range("a" & numCount).End(xlToRight)).Copy _
                ThisWorkbook.Sheets("Sheet1").Range("B65536").End(xlUp).Offset(1, 0)
        End With
        wb.Close False

        ' 获得文件名称
        ' 并且填入单元格
        sFileName = temp
        sFileName = Mid(sFileName, 1, Len(sFileName) - 4)
        endNumber = Application.WorksheetFunction.CountA(Sheet1.Range("B:B"))
        ThisWorkbook.Sheets("Sheet1").Range(Range("A65536").End(xlUp).Offset(1, 0), Range("A" & endNumber)) = sFileName

        Set fso = CreateObject("Scripting.FileSystemObject")
        '如果原地址上存在需要被操作的文件
        If fso.FileExists(originalAdd & fileOperated) Then
            '则将原地址上的文件移到目标文件夹
            fso.movefile originalAdd & fileOperated, targetAdd
        Else
            '如果文件不存在就报告不存在
            MsgBox "文件不存在"
        End If
        '设置fso为空
        Set fso = Nothing
        
        temp = Dir
        fileOperated = temp
    Loop

End Sub

希望再ver 0.0.2的时候，功能会增加的更加完善，并且我也可以自由的用vb操作vlookup函数。