Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
VBA подвисает экспорт в csv при больших объемах
 
#1
24.08.2018 08:01:07
Приветсвую
Макросом ниже - копирую Таблицу из эксель в  csv.
На 20000 строчках - подвисает эксель наглухо. С маленькими объемами работает ок.
Подскажите пожалуйста, что изменить в макросе чтобы с большими объемами могла работать выгрузка в CSV таблицы.
Благодарю!
Код
Sub csvTable(lName As String, tName As String, fName As String)

    Dim tbl As ListObject
    Dim csvFilePath As String
    Dim fNum As Integer
    Dim tblArr
    Dim rowArr
    Dim csvVal

    Set tbl = Worksheets(lName).ListObjects(tName)
    csvFilePath = fName
    tblArr = tbl.Range.Value

    fNum = FreeFile()
    Open csvFilePath For Output As #fNum
    For i = 1 To UBound(tblArr)
        rowArr = Application.Index(tblArr, i, 0)
        csvVal = VBA.Join(rowArr, ",")
        Print #1, csvVal
    Next
    Close #fNum
    Set tblArr = Nothing
    Set rowArr = Nothing
    Set csvVal = Nothing
End Sub
Изменено: Vsevolod - 24.08.2018 08:30:06
 
 
 
#2
24.08.2018 08:52:15
Я думаю вместо
Код
        rowArr = Application.Index(tblArr, i, 0)
        csvVal = VBA.Join(rowArr, ",")

нужно использовать просто цикл по строке и склейку/конкатенацию.
 
 
 
#3
24.08.2018 10:03:46
Hugo, а разве цикл не сделан через for ? прошу прощения, но мои знания vba еще слабы. Не могли бы Вы пример именно самого процесса записи показать, как бы Вы рекомендовали? Благодарю!  
 
 
 
#4
24.08.2018 10:29:22
Цитата
Vsevolod написал:
tblArr = tbl.Range.Value
а через SQL пробовали ?? но на 2 млн. строк всё равно прописывает в txt долго - объём всё-таки... хотя у вас 20 тыс. ...
я на vbs из Access делаю такой логикой (можете адаптировать под свою структуру полей, переделать на макрос И строку подключения к Excel, не Access)... выходной файл пустой уже создан 11.txt - можете создавать в коде...
главное: это пример как взять запросом таблицу и Do-Loop'ом пробежать по Рекордсету, записывая записи рекордсета в txt-файл...
но в SQL-запросе * лучше заменить на названия своих полей (лучше для скорости работы провайдера БД Jet, который в XL) - я сократила для краткости, но выгрузку показала на примере своих полей для примера...
Код
Const FOR_APPENDING = 8

Set pCon = CreateObject("ADODB.Connection")
sFilename = "E:\NEW docs\myDB.accdb"
toFile="E:\NEW docs\11.txt"
pCon.Open "Provider=Microsoft.ACE.OLEDB.12.0;Mode=16;DataSource=" & sFilename & ""

   sSQL = "SELECT * FROM [tbl]; " 
   set RS = pCon.Execute(sSQL)   

Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.OpenTextFile(toFile,FOR_APPENDING)

Do While Not RS.EOF
    objFile.Write CStr(RS.Fields("TK").Value & ";" & RS.Fields("settlementDt").Value & ";" & VBCRLF)
    RS.MoveNext
Loop

objFile.Close
RS.Close
pCon.Close
Set RS = Nothing
Set pCon = Nothing
Изменено: JeyCi - 24.08.2018 10:32:53
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
 
 
#5
24.08.2018 16:58:29
Следующий макрос справится с таблицей из #1 за пару секунд (шапка функции та же):
Код
' Экспорт в csv-файл fName таблицы tName на листе lName. Разделитель полей - запятая
Sub csvTable(lName As String, tName As String, fName As String)
    Dim tbl As ListObject
    Set tbl = Worksheets(lName).ListObjects(tName)
    Workbooks.Add
    tbl.Range.Copy Range("A1")
    With ActiveWorkbook
      .SaveAs fName, xlCSV, local:=False
      .Saved = True
      .Close
    End With
End Sub
Изменено: sokol92 - 24.08.2018 17:06:10
Владимир
 
 
 
#6
29.08.2018 05:28:14
sokol92, благодарю! буду пробовать
JeyCi, благодарю за помощь!  
 
 
 
Страницы: 1
Наверх