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

Вход

Регистрация

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

 

= Мир MS Excel/Выгрузить массив в эксель - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выгрузить массив в эксель (Макросы/Sub)
Выгрузить массив в эксель
Sobirjon Дата: Пятница, 10.06.2022, 06:07 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 151
Репутация: 2 ±
Замечаний: 0% ±

2016
При обработке двух текстовых документов, у одного возникает ошибка : «Run-time error '7':Out of memory»
Отличия между ними в количестве столбцов (если можно так выразится)
Суть макроса прочесть содержимое текстового документа и выгрузить в эксель.
Текстовый документ с названием «Элементы» выгружается без проблем и как надо, а вот »Материалы» выдает ошибку выше.

Сам код:
[vba]
Код
Sub ReadTextFile()
    Dim arrTmp, arrLines
    Dim sFileName$, sTxtAll$, sPriceName$
    Dim lRows&, i&, j&, lColumns&
    sFileName = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    If sFileName = "False" Then Exit Sub
    
    sTxtAll = CreateObject("Scripting.FileSystemObject").Getfile(sFileName).OpenAsTextStream(1).ReadAll
    
    If InStr(sTxtAll, "# Parts") > 0 Then
        sPriceName = "Элементы"
    ElseIf InStr(sTxtAll, "# Materials") > 0 Then
        sPriceName = "Материалы"
    Else
        MsgBox "Не верный файл!!!", vbCritical, "Неверный файл"
        Exit Sub
    End If

    lRows = UBound(Split(sTxtAll, vbCrLf))         ' кол-во строк для массива
    arrLines = Split(sTxtAll, vbCrLf)
    lColumns = UBound(Split(arrLines(1), vbTab))        ' кол-во столбцов для массива
    ReDim arrTmp(1 To lRows, 1 To lColumns + 1)    ' размер массива

    For i = 1 To lRows
        For j = 0 To UBound(Split(arrLines(i - 1), vbTab))
            arrTmp(i, j + 1) = Split(arrLines(i - 1), vbTab)(j)
    Next j, i
    With ThisWorkbook.Worksheets(sPriceName)
        .Range("A1").Resize(UBound(arrTmp, 1), UBound(arrTmp, 2)).Value = arrTmp' Ошибка возникает здесь
    End With
End Sub
[/vba]
Строка где возникает ошибка:
[vba]
Код
.Range("A1").Resize(UBound(arrTmp, 1), UBound(arrTmp, 2)).Value = arrTmp
[/vba]
Пробовал выгрузить в лоб указав границы массива вручную, всё равно не помогает.
Надеюсь на помощь спецов. Спасибо!!!
PS строго не судите название темы, в голову больше ни чё не пришло %)
К сообщению приложен файл: Desktop.rar (14.6 Kb)
 
Ответить
СообщениеПри обработке двух текстовых документов, у одного возникает ошибка : «Run-time error '7':Out of memory»
Отличия между ними в количестве столбцов (если можно так выразится)
Суть макроса прочесть содержимое текстового документа и выгрузить в эксель.
Текстовый документ с названием «Элементы» выгружается без проблем и как надо, а вот »Материалы» выдает ошибку выше.

Сам код:
[vba]
Код
Sub ReadTextFile()
    Dim arrTmp, arrLines
    Dim sFileName$, sTxtAll$, sPriceName$
    Dim lRows&, i&, j&, lColumns&
    sFileName = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    If sFileName = "False" Then Exit Sub
    
    sTxtAll = CreateObject("Scripting.FileSystemObject").Getfile(sFileName).OpenAsTextStream(1).ReadAll
    
    If InStr(sTxtAll, "# Parts") > 0 Then
        sPriceName = "Элементы"
    ElseIf InStr(sTxtAll, "# Materials") > 0 Then
        sPriceName = "Материалы"
    Else
        MsgBox "Не верный файл!!!", vbCritical, "Неверный файл"
        Exit Sub
    End If

    lRows = UBound(Split(sTxtAll, vbCrLf))         ' кол-во строк для массива
    arrLines = Split(sTxtAll, vbCrLf)
    lColumns = UBound(Split(arrLines(1), vbTab))        ' кол-во столбцов для массива
    ReDim arrTmp(1 To lRows, 1 To lColumns + 1)    ' размер массива

    For i = 1 To lRows
        For j = 0 To UBound(Split(arrLines(i - 1), vbTab))
            arrTmp(i, j + 1) = Split(arrLines(i - 1), vbTab)(j)
    Next j, i
    With ThisWorkbook.Worksheets(sPriceName)
        .Range("A1").Resize(UBound(arrTmp, 1), UBound(arrTmp, 2)).Value = arrTmp' Ошибка возникает здесь
    End With
End Sub
[/vba]
Строка где возникает ошибка:
[vba]
Код
.Range("A1").Resize(UBound(arrTmp, 1), UBound(arrTmp, 2)).Value = arrTmp
[/vba]
Пробовал выгрузить в лоб указав границы массива вручную, всё равно не помогает.
Надеюсь на помощь спецов. Спасибо!!!
PS строго не судите название темы, в голову больше ни чё не пришло %)

Автор - Sobirjon
Дата добавления - 10.06.2022 в 06:07
Sobirjon Дата: Пятница, 10.06.2022, 07:26 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 151
Репутация: 2 ±
Замечаний: 0% ±

2016
всё, разобрался))). Не давала этого делать строка "====== ЛДСП EGGER ======"
 
Ответить
Сообщениевсё, разобрался))). Не давала этого делать строка "====== ЛДСП EGGER ======"

Автор - Sobirjon
Дата добавления - 10.06.2022 в 07:26
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выгрузить массив в эксель (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!