将多个.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 

有人告诉我，我应该replace这个，将导入的文本分成列：

 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 

与Excelmacroslogging器中的文本到列的东西，但我不知道我需要把什么variables放到代码中。 使用这应该使它更快我猜，但它需要定制。

 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 

也许有人可以帮助我？