0 / 0 / 0
Регистрация: 06.10.2011
Сообщений: 13
1

Ошибка "Run-time error "9": Subscript out of range"

06.10.2011, 15:29. Показов 9013. Ответов 3
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Доброго времени суток. Программа выводит ошибку "Run-time error "9": Subscript out of range", но не могу понять почему. Помогите пожалуйста.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Загрузка данных из файлов()
    ' папка, в которой будет производиться поиск файлов DAT для обработки
    ПапкаДляФайлов$ = "E:\Data"
 
    Dim ErrorsArray    ' пустой массив для ошибок
 
    ' Считываем данные из всех файлов .DAT в папке в двумерный массив
    DataArr = DATfolder2Array(ПапкаДляФайлов$, 4, "", ErrorsArray)
 
    ' результаты выводим на листы "errors" и  "result" (они должны существовать)
    'Array2worksheet Worksheets("îøèáêè"), ErrorsArray, _
                    Array("Имя файла", "Номер строки, "Данные из строки")
    
    Array2worksheet Worksheets("ðåçóëüòàò"), DataArr, _
                    Array("Столбец 1", "Столбец 2", "Столбец 3", "Столбец 4")
End Sub
Сама функция DATfolder2Array
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Function DATfolder2Array(ByVal FolderPath$, ByVal ColumnsCount As Long, _
                         ByVal TextColumns$, ByRef ErrorsArr) As Variant
    ' получает путь FolderPath$ к папке с DAT-файлами
   ' считывает из файлов все строки, в которых число записей в строке равно ColumnsCount
   ' остальные (неподходящие) строки отправляет в массив ErrorsArr
   ' (столбцы ErrorsArr: 1-имя файла, 2 - номер строки, 3 - данные)
   ' в переменной TextColumns$ через запятую перечислены номера ТЕКСТОВЫХ столбцов
   ' Возвращает двумерный массив размером N*ColumnsCount
 
    ReDim ErrorsArr(1 To 1000, 1 To ColumnsCount + 2)
    On Error Resume Next
 
    Dim coll As New Collection, filename
    filename = Dir(FolderPath$ & "*.dat")
    While filename <> ""
        coll.Add filename    ' считываем в коллекцию coll нужные имена файлов
        filename = Dir
    Wend
 
    Dim newtxt As String, ro As String, errIndex As Long
    For Each filename In coll
        Application.StatusBar = "Îáðàáàòûâàåòñÿ ôàéë: " & filename
        newtxt = Split(ReadTXTfile(FolderPath$ & filename), vbLf, 2)(1)
        tempArr = "": tempArr = Split(newtxt, vbNewLine)
        For i = LBound(tempArr) To UBound(tempArr)
            ro = tempArr(i): ro = Replace(ro, vbTab, ";")
            If UBound(Split(ro, ";")) <> ColumnsCount - 1 And Len(Trim(ro)) > 0 Then
                tempArr(i) = "": errIndex = errIndex + 1
                ErrorsArr(errIndex, 1) = filename
                ErrorsArr(errIndex, 2) = "Ñòðîêà " & i + 1
                ErrorsArr(errIndex, 3) = ro
            End If
        Next i
        newtxt = Join(tempArr, vbNewLine)
        txt = txt & newtxt & vbNewLine: DoEvents
    Next
    While InStr(1, txt, vbNewLine & vbNewLine) > 0
        txt = Replace(txt, vbNewLine & vbNewLine, vbNewLine)
    Wend
 
    txt = Replace(txt, vbTab, ";"): tempArr = Split(txt, vbNewLine)
    ReDim newArr(1 To UBound(tempArr), 1 To ColumnsCount)
 
    For i = LBound(tempArr) To UBound(tempArr)
        roArr = "": roArr = Split(tempArr(i), ";")
        For j = 1 To ColumnsCount
            newArr(i + 1, j) = roArr(j - 1)
            If "," & TextColumns$ & "," Like "*," & j & ",*" Then
                newArr(i + 1, j) = "'" & newArr(i + 1, j)
            End If
        Next j
    Next i
    DATfolder2Array = newArr
    Application.StatusBar = False
End Function
Функция Arrayy2worksheet
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Array2worksheet(ByRef sh As Worksheet, ByVal arr, ByVal ColumnsNames)
    ' Получает двумерный массив Arr с данными,
   ' и массив заголовков столбцов ColumnsNames.
   ' Заносит данные из массива на лист sh
    
    If UBound(arr, 1) > sh.Rows.Count - 1 Or UBound(arr, 2) > sh.Columns.Count Then
        MsgBox "Массив не влезет на лист " & sh.Name, vbCritical, _
               "Размеры массива:  " & UBound(arr, 1) & "*" & UBound(arr, 2): End
    End If
    With sh
        .UsedRange.ClearContents
        ColumnsNamesCount = UBound(ColumnsNames) - LBound(ColumnsNames) + 1
        .Range("a1").Resize(, ColumnsNamesCount).Value = ColumnsNames
        .Range("a1").Resize(, ColumnsNamesCount).Interior.ColorIndex = 15
        .Range("a2").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
        '.UsedRange.EntireColumn.AutoFit
    End With
End Sub
Функция ReadTXTfile
Visual Basic
1
2
3
4
5
Function ReadTXTfile(ByVal filename As String) As String
    Set fso = CreateObject("scripting.filesystemobject")
    Set ts = fso.OpenTextFile(filename, 1, True): ReadTXTfile = ts.ReadAll: ts.Close
    Set ts = Nothing: Set fso = Nothing
End Function
Функция CombineArrays
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Function CombineArrays(Arr1 As Variant, Arr2 As Variant) As Variant
    'функция CombineArrays объединяет 2 двумерных массива ОДИНАКОВОЙ ШИРИНЫ в один массив
   '(второй массив "дописывается" ниже первого, путем добавления строк из второго массива в первый)
   'Функция возвращает массив той же ширины, что и исходные,
   'а вертикальная размерность возвращаемого массива равна сумме количества строк исходных массивов
   '
   'В случае, если один из массивов не задан, функция возвращает другой заданный массив (без изменений)
   'ВНИМАНИЕ: все размерности массивов 1 и 2 должны совпадать (кроме первой размерности - по высоте)
   'Подразумевается, что индексы массивов начинаются с 1 (директива Option Base 1)
 
 
    ' если один из параметров не является массивом, функция возвращает другой параметр (массив)
   If (Not IsArray(Arr1)) And IsArray(Arr2) Then CombineArrays = Arr2: Exit Function
    If (Not IsArray(Arr2)) And IsArray(Arr1) Then CombineArrays = Arr1: Exit Function
    ' если оба параметра функции не являются массивами
   If (Not IsArray(Arr2)) And (Not IsArray(Arr1)) Then
        Debug.Print "ОШИБКА: Оба переданных значения не являются массивами!"
        CombineArrays = Null: Exit Function
    End If
 
    ' проверяем совпадение размерностей массивов Arr1 и Arr2
   On Error Resume Next: Err.Clear
 
    If (LBound(Arr1, 2) <> LBound(Arr2, 2)) Or (UBound(Arr1, 2) <> UBound(Arr2, 2)) Then
        Debug.Print "ОШИБКА: Размерности массивов (по ширине) не совпадают"
        CombineArrays = Null: Exit Function
    End If
    If Err.Number = 9 Then
        Debug.Print "ОШИБКА: Один из массивов не является двумерным!"
        CombineArrays = Null: Exit Function
    End If
 
 
    ReDim arr(1 To UBound(Arr1, 1) + UBound(Arr2, 1), LBound(Arr1, 2) To UBound(Arr1, 2))
 
    For i = 1 To UBound(Arr1, 1)
        For j = LBound(Arr1, 2) To UBound(Arr1, 2)
            arr(i, j) = Arr1(i, j)
        Next
    Next
 
    For i = 1 To UBound(Arr2, 1)
        For j = LBound(Arr2, 2) To UBound(Arr2, 2)
            arr(i + UBound(Arr1, 1), j) = Arr2(i, j)
        Next
    Next
    CombineArrays = arr    ' возвращаем объединённый массив
End Function
Файлы перевел в .txt для того, чтобы выложить в тему. Они созданы для примера. Реальный массив, который нужно обработать, гораздо больше. Но хотелось бы для начала разобраться с этими файлами.
Вложения
Тип файла: txt 1.txt (16 байт, 47 просмотров)
Тип файла: txt 2.txt (16 байт, 28 просмотров)
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
06.10.2011, 15:29
Ответы с готовыми решениями:

Ошибка в БД "run-time error '3022':"
Private Sub Command1_Click() Data2.Refresh Data2.Recordset.AddNew...

Run time error "424" Необходим объект
Private Sub Command1_Click() Set WshShell = WScript.CreateObject(&quot;WScript.Shell&quot;) kl = True Do...

Run-time error 380: "Invalid property value"
На другой (тестовой) машине программа выдает ошибку: 'Run-time error 380. Invalid property...

Ошибка при работе с матрицей "Subscript out of range"
Всем привет, есть код : Private Sub cmd_start_Click() Dim x(4) As Single, y(7) As Single, S...

3
es geht mir gut
11267 / 4749 / 1183
Регистрация: 27.07.2011
Сообщений: 11,439
06.10.2011, 16:43 2
А какую строку подсвечивает при ошибке?
Или это уже в скомпилированной программе? Или на другой машине?
0
0 / 0 / 0
Регистрация: 06.10.2011
Сообщений: 13
06.10.2011, 16:48  [ТС] 3
Ой, извиняюсь, забыл указать. В коде:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Загрузка данных из файлов()
    ' папка, в которой будет производиться поиск файлов DAT для обработки
    ПапкаДляФайлов$ = "E:\Data"
 
    Dim ErrorsArray    ' пустой массив для ошибок
 
    ' Считываем данные из всех файлов .DAT в папке в двумерный массив
    DataArr = DATfolder2Array(ПапкаДляФайлов$, 4, "", ErrorsArray)
 
    ' результаты выводим на листы "errors" и  "result" (они должны существовать)
    'Array2worksheet Worksheets("ошибки"), ErrorsArray, _
                    Array("Имя файла", "Номер строки, "Данные из строки")
    
    Array2worksheet Worksheets("результат"), DataArr, _
                    Array("Столбец 1", "Столбец 2", "Столбец 3", "Столбец 4")
End Sub
 
 [/BASIC]
 
Подсвечивает строку: 
[BASIC]Array2worksheet Worksheets("результат"), DataArr, _
                    Array("Столбец 1", "Столбец 2", "Столбец 3", "Столбец 4")
Нет, это еще не скомпилированная программа.

 Комментарий модератора 
В этом разделе код должен быть заключен в тег "VB"
0
0 / 0 / 0
Регистрация: 06.10.2011
Сообщений: 13
20.10.2011, 16:02  [ТС] 4
Спасибо. Решение на этот вопрос не нашел. Пришлось написать другую программу.
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
20.10.2011, 16:02
Помогаю со студенческими работами здесь

Run-time error "13" Несовпадение типов при работе с дробями
Добавлено через 53 секунды проблема с кодом. кто может посмотрите и подскажите что не так

Ошибка "runtime error 1004 method range of object global failed"
Ошибка &quot;runtime error 1004 method range of object global failed&quot; при вызове формы. ' Инвестиции...

Ошибка "runtime error 1004 method range of object global failed" при загрузке из excel в textbox
Выходит ошибка runtime error 1004 method range of object global failed при загрузки данных из файла...

Замена символа на его двухзначный порядковый номер в алфавите (например "а" меняется на "01", "к" на "12")
Нужна помощь


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
4
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2023, CyberForum.ru