将Excel中的数据整理到另一Excel

来源：互联网发布：mysql压缩包怎么安装编辑：程序博客网时间：2024/05/17 22:06

Sub paste()    Dim fs, folder, files    Dim errPath As String    Dim filePath As String    Dim iCnt As Integer    Dim iLine As Long    Dim flg As Boolean    Dim temp        iCnt = Cells(1, 2)    errPath = Cells(2, 2)    filePath = Cells(3, 2)        Workbooks.Open filePath    iLine = 0    Set fs = CreateObject("Scripting.FileSystemObject")    Set folder = fs.getfolder(errPath)    For i = 1 To iCnt        flg = False        iLine = iLine + 1        Cells(iLine, 1) = "Title"        For Each f In folder.files            temp = Split(f.Name, ".")            If Right(temp(0), 3) = Format(i * 2, "000") Then                iLine = iLine + 1                Cells(iLine, 1) = f.Name                flg = True                Open f.path For Input As #1                Do Until EOF(1)                    Line Input #1, strline                    temp = Split(strline, ",")                    iLine = iLine + 1                    For j = 0 To UBound(temp)                        Cells(iLine, j + 1) = Replace(temp(j), Chr(34), "")                    Next j                Loop                Close #1            End If        Next        If flg = False Then            iLine = iLine + 1            Cells(iLine, 1) = "No File"            iLine = iLine + 5        End If            Next i    End Sub

0 0