将多个.csv文件导入列

时间:2015-10-23 09:15:47

标签: excel vba excel-vba csv

我的VBA代码非常慢:

Sub getMoreSpeed(bDoIt As Boolean)
    Application.ScreenUpdating = Not (bDoIt)
    Application.EnableEvents = Not (bDoIt)
    Application.Calculation = IIf(bDoIt, xlCalculationManual, xlCalculationAutomatic)
    Application.Cursor = IIf(bDoIt, 2, -4143)
End Sub

    Sub import_0Grad()
Call getMoreSpeed(True)
            Dim fd As FileDialog
            Dim strFolder As String
            Dim strName As String
            Dim intCol As Integer
            Dim rngCell As Range
            Dim ws As Worksheet
            Dim varArr As Variant
            Dim i As Long

            Set ws = ThisWorkbook.Sheets(3)

            Set fd = Application.FileDialog(msoFileDialogFolderPicker)
            If fd.Show <> -1 Then Exit Sub

            strFolder = fd.SelectedItems(1) & "\"
            strName = Dir(strFolder & "*.csv")
            Set rngCell = ws.Cells(2, Columns.Count)

            While Len(strName) > 0
               If IsEmpty(rngCell.End(xlToLeft).Value) Then
                   intCol = 1
               Else:
                   intCol = rngCell.End(xlToLeft).Column + 1
               End If
               Workbooks.OpenText Filename:=strFolder & strName, Local:=True
               ActiveSheet.UsedRange.Copy ws.Cells(2, intCol)
               ws.Cells(1, intCol).Value = strName
               ActiveWorkbook.Close SaveChanges:=False
               strName = Dir

               For i = 2 To ws.Cells(Rows.Count, intCol).End(xlUp).Row
                    varArr = Split(ws.Cells(i, intCol).Value, " ")
                    ws.Cells(i, intCol).Value = varArr(0)
                    ws.Cells(i, intCol + 1).Value = varArr(1)
               Next i
            Wend

            Set ws = Nothing
            Set fd = Nothing
            Set rngCell = Nothing

  Call getMoreSpeed(False)

    End Sub

有人告诉我,我应该替换它,将导入的文本分成列:

For i = 2 To ws.Cells(Rows.Count, intCol).End(xlUp).Row
                    varArr = Split(ws.Cells(i, intCol).Value, " ")
                    ws.Cells(i, intCol).Value = varArr(0)
                    ws.Cells(i, intCol + 1).Value = varArr(1)
               Next i

使用Excel宏记录器中的Text To Columns,但我不知道需要将哪些变量放入代码中。使用它应该让它更快我猜,但它需要定制。

Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

也许有人可以帮助我?

0 个答案:

没有答案