Sub example_01() 'для csv-файлов
Dim f$, x, i&, j&, t, y()
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Please select a file": .InitialFileName = ThisWorkbook.Path
.Filters.Add "Excel", "*.csv", 1: .AllowMultiSelect = False
If .Show = False Then Exit Sub: If .SelectedItems.Count = 0 Then Exit Sub
f = .SelectedItems(1)
End With
'или конкретно указать
'f = ThisWorkbook.Path & "\gc_m1440_20130101_20131231.csv"
f = CreateObject("scripting.filesystemobject").OpenTextFile(f).ReadAll
x = Split(f, vbLf)
'ReDim y(1 To UBound(x), 1 To 13)
'or
ReDim y(1 To UBound(x), 1 To UBound(Split(x(0), ";")) + 1)
For i = 0 To UBound(x)
t = Split(x(i), ";")
For j = 0 To UBound(t)
y(i + 1, j + 1) = t(j) 'Trim(t(j))
Next j
Next i
Application.ScreenUpdating = False
ActiveSheet.UsedRange.ClearContents
Range("A1").Resize(i - 1, UBound(y, 2)).Value = y()
Application.ScreenUpdating = True
End Sub
Sub example_02()
'д.б. подключена MS ActiveX Data Objects 6.1 Library (6.1 - для примера)
Dim rsData As ADODB.Recordset, sConnect As String, sSQL As String
sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.Path & "\;" & _
"Extended Properties=Text;" '"Extended Properties=""Text;HDR=No"";"
sSQL = "SELECT * FROM gc_m1440_20130101_20131231.csv;"
'sSQL = "SELECT * FROM gc_m1440_20130101_20131231.csv WHERE Type='Art';"
Set rsData = New ADODB.Recordset
rsData.Open sSQL, sConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
If Not rsData.EOF Then
With Sheets("Sheet1")
.Range("A1").CopyFromRecordset rsData
' .Columns(1).TextToColumns .Cells(1), Other:=True, OtherChar:=";"
End With
Else
MsgBox "Ошибка: записи не загружены", 16
End If
rsData.Close: Set rsData = Nothing
End Sub
Sub example_03()
'Dim tm!: tm = Timer
Dim fldr As String, i As Long, arr(), ubnd As Long
Application.ScreenUpdating = False
fldr = ThisWorkbook.Path: If Right(fldr, 1) <> "\" Then fldr = fldr & "\"
ReDim arr(1 To 10000, 1 To 1): ubnd = UBound(arr)
Open fldr & "Книга1.csv" For Input As #1
Do Until EOF(1)
i = i + 1: If i > ubnd Then ToWSheet arr, i - 1: i = 1
Line Input #1, arr(i, 1)
Loop
Close #1
ToWSheet arr, i
Application.ScreenUpdating = True
'MsgBox Timer - tm
End Sub
Sub ToWSheet(x, j&) 'для example_03
ActiveSheet.Cells(Rows.Count, 1).End(xlUp)(2, 1).Resize(j).Value = x
End Sub
|