Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Готовые решения

МЕНЮ САЙТА
  • 1
  • 2
  • 3

КАТЕГОРИИ РАЗДЕЛА

ОПРОСЫ
Какой версией Excel Вы пользуетесь?
Всего ответов: 35687
Главная » Готовые решения » VBA » Полезные приёмы

Текстовые файлы. Импорт в Excel
31.12.2013, 23:49
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
Добавил: nilem |
Просмотров: 3900 | Рейтинг: 0.0/0
Всего комментариев: 1
0   Спам
1    asus10   (09.03.2014 17:42)
   hands

Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!