powered by simpleCommunicator - 2.0.55     © 2025 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / помогите с ошибкой
33 сообщений из 33, показаны все 2 страниц
помогите с ошибкой
    #37318834
afrobiba
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
здравствуйте! вообщем такое дело: сегодня у друга на компьютере сделал вещь на VBA которая перекидывает из текстовика в excel и распредиляет там по листам. сделал таким образом: из access запускаю excel с макросом. макрос в свою очередь уже и занимается вышеописынами вещами. вроде бы все сделал и все работало. но когда пришел домой и попробывал протестировать на своем ПК, стал выдавать ошибку "syntax error" и выделять первую строку данного куска кода
Код: plaintext
1.
2.
3.
4.
 Workbooks.OpenText Filename:="H:\on123.txt", Origin:= 866 , StartRow:= 1 ,
        DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter _
        :=True, Tab:=True, Semicolon:=False, Comma:=False, Space:=True, Other _
        :=False, FieldInfo:=Array(Array( 1 ,  1 ), Array( 2 ,  1 ), Array( 3 ,  1 )), _
        TrailingMinusNumbers:=True
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37318836
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
afrobiba,

подчеркивание потерял в первой строке
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37318837
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
afrobiba
1
что за ошибка
2
есть дома такой файл
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37318838
afrobiba
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
всем спасибо, все свободны!
нашел проблему сам - вспемнил что у него просто офис 2010 а у меня 2007
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37318841
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
afrobibaвсем спасибо, все свободны!
нашел проблему сам - вспемнил что у него просто офис 2010 а у меня 2007и как это связано с синтаксической ошибкой?
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37318842
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Шокер Вам толкует
StartRow:=1, подчёркивание_____________где?
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37318846
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
>все свободны!
, ОК!
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37318851
afrobiba
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
извиняйте, поторопился с выводами!
спасибо за подчеркивание
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37318860
afrobiba
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
а можете помочь еще по одному вопросу?
Код: plaintext
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.
Dim a
Dim tmp As String
a =  1 
lLastRow = Cells.SpecialCells(xlLastCell).Row
For a =  1  To lLastRow
tmp = Cells(a,  1 )
'==========================56=====================
If Mid(tmp,  1 ,  6 ) =  351356  Then
    If IsWorkSheetExist("56") = False Then
    Set sh = Sheets.Add
    sheetname = "56"
    sh.Name = sheetname
    Sheets("on123").Select
    Else
    Sheets("on123").Select
    End If
    'copy & paste===============================
    Rows(a & ":" & a).Select
    Selection.Copy
    Sheets("56").Select
    Rows(Cells.SpecialCells(xlLastCell).Row +  1  & ":" & Cells.SpecialCells(xlLastCell).Row +  1 ).Select
    ActiveSheet.Paste
End If
Sheets("on123").Select
Next a
'=====bla bla ( =====
       'Workbooks("start.xlsm").Close
End Sub
вот эта часть как раз и раскидыввает строки по листам( в данном случае только одному листу для экономии места). выделяет часть "Sheets("on123").Select" и пишет "Error 9: Subscript out of range"и не создает новый лист и не кидает в него строки
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37318868
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
afrobiba,
Excel не может найти лист с именем 'on123'
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37318870
afrobiba
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
скукотища,

он есть. точнее это единственный лист в книге.
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37318895
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
afrobibaскукотища,

он есть. точнее это единственный лист в книге.Чем дальше, тем страннее (с) Алиса

Поставьте точку останова на выделенной строке. Посмотрите, что у вас на этот момент содержится в переменной sh . Метод Add , если верить справке по Excel, не возвращает ссылку на добавленный лист.
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
If Mid(tmp,  1 ,  6 ) =  351356  Then
    If IsWorkSheetExist("56") = False Then
    Set sh = Sheets.Add
    sheetname = "56"  ' здесь точку останова
    sh.Name = sheetname
    Sheets("on123").Select
    Else
    Sheets("on123").Select
    End If
    'copy & paste===============================
    Rows(a & ":" & a).Select
    Selection.Copy
    Sheets("56").Select
    Rows(Cells.SpecialCells(xlLastCell).Row +  1  & ":" & Cells.SpecialCells(xlLastCell).Row +  1 ).Select
    ActiveSheet.Paste
End If
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37318917
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
... справка врёт
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37318926
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
afrobiba выделяет часть "Sheets("on123").Select" и пишет "Error 9: Subscript out of range"и не создает новый лист и не кидает в него строкишота ты гонишь. Новый лист создается как раз ДО того, как в дело вступает указанная строка
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37318932
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro,
не судите, и не судимы бу (с) Holly Bible

ТС представил на обозрение лишь малую часть соего шедевра. И не факт, что Excel ругается на строку из приведенной части кода...

ЗЫ: гонит, однозначно
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37318938
afrobiba
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro,

а смысл мне вам врать? говорю все как есть. после вывода ошибки на монитор в книге есть только один лист с данными и все.
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37318958
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
afrobiba,

тестовый файл в студию
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37318962
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
afrobiba,
смысла врать, конечно же, нету.
Запустите свой код на выполнение, когда вывалится ошибка, выберите "Debug", и в окне отладки запустите такое:
Код: plaintext
for i= 1  to Sheets.Count:?"~" & Sheets(i).Name & "~": next i
Получите имена листов, про которые знает Excel
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37318980
afrobiba
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro,
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37318993
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
afrobiba,

нуну
а по делу что-нибудь приложишь?
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37319010
afrobiba
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro,

Код: plaintext
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.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
Private Function IsWorkSheetExist(sSName As String) As Boolean
Dim c As Object
On Error GoTo errНandle:
Set c = Sheets(sSName)
' Альтернативный вариант :
Worksheets(sSName).Cells( 1 ,  1 ) = Worksheets(sSName).Cells( 1 ,  1 )
IsWorkSheetExist = True
Exit Function
errНandle:
IsWorkSheetExist = False
End Function
Private Sub Workbook_Open()
Application.ScreenUpdating = False
 Workbooks.OpenText Filename:="H:\on123.txt", Origin:= 866 , StartRow:= 1 , _
        DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter _
        :=True, Tab:=True, Semicolon:=False, Comma:=False, Space:=True, Other _
        :=False, FieldInfo:=Array(Array( 1 ,  1 ), Array( 2 ,  1 ), Array( 3 ,  1 )), _
        TrailingMinusNumbers:=True
    ActiveWorkbook.SaveAs Filename:="h:\on123123", FileFormat:=xlExcel5, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
        
        
        '==bla bla bla )====
        ScreenUpdating = False
Dim a
Dim tmp As String
a =  1 
lLastRow = Cells.SpecialCells(xlLastCell).Row
For a =  1  To lLastRow
tmp = Cells(a,  1 )
'==========================52=====================
If Mid(tmp,  1 ,  6 ) =  351352  Then
    If IsWorkSheetExist("оптс") = False Then
    Set sh = Sheets.Add
    sheetname = "оптс"
    sh.Name = sheetname
    Sheets("on123").Select
    Else
    Sheets("on123").Select
    End If
    'copy & paste===============================
    Rows(a & ":" & a).Select
    Selection.Copy
    Sheets("оптс").Select
    Rows(Cells.SpecialCells(xlLastCell).Row +  1  & ":" & Cells.SpecialCells(xlLastCell).Row +  1 ).Select
    ActiveSheet.Paste
End If
'==========================56=====================
If Mid(tmp,  1 ,  6 ) =  351356  Then
    If IsWorkSheetExist("56") = False Then
    Set sh = Sheets.Add
    sheetname = "56"
    sh.Name = sheetname
    Sheets("on123").Select
    Else
    Sheets("on123").Select
    End If
    'copy & paste===============================
    Rows(a & ":" & a).Select
    Selection.Copy
    Sheets("56").Select
    Rows(Cells.SpecialCells(xlLastCell).Row +  1  & ":" & Cells.SpecialCells(xlLastCell).Row +  1 ).Select
    ActiveSheet.Paste
End If
Sheets("on123").Select
Next a
'=====bla bla ( =====
       'Workbooks("start.xlsm").Close
End Sub
вам это?
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37319019
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
afrobiba,
так и не последовали моему совету
В вашей книге НЕТ листа с именем 'on123'. Такой лист есть во вновь созданной книге .
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37319046
afrobiba
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
скукотища,

знал бы как это сделать обязательно сделал бы.
P.S. у меня уже 3 часа ночи так что если что завтра попробую
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37319051
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
afrobiba вам это?
мне бы тестовый файл, который я запустил бы и увидел ошибку собственными глазами, а не собирал из опубликованных тобой здесь фрагментов. Вообще-то в твоих интересах максимально облегчить жизнь помогающим тебе нахаляву из чистого интереса, а не затруднять ее, не находишь?

Впрочем, скукотища уже смог обнаружить ошибку. Обращаясь через Sheets, ты обращаешься к набору листов текущей книги, а хочешь, как я понимаю - к вновь созданной.

Вообще-то, если мне не изменяет память, я тебе уже показывал, как присвоить переменной ссылку на новую книгу и впоследствии к ней обращаться.
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37319065
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
afrobibaскукотища,

знал бы как это сделать обязательно сделал бы.
P.S. у меня уже 3 часа ночи так что если что завтра попробуюПопробуйте
Код: plaintext
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.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
Option Explicit

' *************************************
' есть ли данный лист в данной книге
Private Function IsWorkSheetExist(w As Workbook, sSName$) As Boolean
Dim c As Object
On Error GoTo errНandle:
Set c = w.Sheets(sSName)
' Альтернативный вариант :
w.Worksheets(sSName).Cells( 1 ,  1 ) = w.Worksheets(sSName).Cells( 1 ,  1 )
IsWorkSheetExist = True
Exit Function
errНandle:
IsWorkSheetExist = False
End Function

' *************************************
Private Sub Workbook_Open()
Dim wb As Workbook, sh As Worksheet
Dim a&, lLastRow&, k&
Dim tmp$, sSheetName$

Application.ScreenUpdating = False

Workbooks.OpenText Filename:="H:\on123.txt", Origin:= 866 , StartRow:= 1 , _
        DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter _
        :=True, Tab:=True, Semicolon:=False, Comma:=False, Space:=True, Other _
        :=False, FieldInfo:=Array(Array( 1 ,  1 ), Array( 2 ,  1 ), Array( 3 ,  1 )), _
        TrailingMinusNumbers:=True

Set wb = Workbooks(Workbooks.Count)
wb.SaveAs Filename:="H:\on123123", FileFormat:=xlExcel5

        '==bla bla bla )====

With wb.Worksheets( 1 )
    lLastRow = .Cells.SpecialCells(xlLastCell).Row
    
    For a =  1  To lLastRow
        tmp = Mid(.Cells(a,  1 ),  1 ,  6 )
        
        Select Case tmp
            Case "351352":  sSheetName = "оптс"
            Case "351356":  sSheetName = "56"
            Case Else:      sSheetName = ""
        End Select
        
        If sSheetName = "" Then
             ' обработка непредвиденных случаев

        Else
            If IsWorkSheetExist(wb, sSheetName) Then
                Set sh = .Parent.Worksheets(sSheetName)
                k = sh.Cells.SpecialCells(xlLastCell).Row +  1 
            Else
                Set sh = .Parent.Worksheets.Add
                sh.Name = sSheetName
                k =  1 
            End If
'' rem можно и без функции IsWorkSheetExist
''            On Error Resume Next
''            Set sh = .Parent.Worksheets(sSheetName)
''            If Err.Number <> 0 Then
''                Err.Clear
''                Set sh = .Parent.Worksheets.Add
''                sh.Name = sSheetName
''                k = 1
''            Else
''                k = sh.Cells.SpecialCells(xlLastCell).Row + 1
''            End If
''            On Error GoTo 0
'' rem
            
            .Rows(a).Copy sh.Cells(k,  1 )
        End If
    Next a
End With ' wb.Worksheets(1)

Application.CutCopyMode = False
Application.ScreenUpdating = True

'=====bla bla ( =====
       'Workbooks("start.xlsm").Close
End Sub

...
Рейтинг: 0 / 0
помогите с ошибкой
    #37319334
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
скукотища,
Код: plaintext
Set wb = Workbooks(Workbooks.Count)
ну что за извращение?


Код: plaintext
Set wb = Workbooks.OpenText(....
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37320347
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro,
меня с конструкцией
Код: plaintext
Set wb = Workbooks.OpenText(....
Excel 2k3 посылает в пеший эротический тур. Может слов волшебных не знаю...
Потому и извращаюсь.
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37320517
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
скукотища,

ну ты прям как студент...
что за ошибка-то?
у меня тоже 2к - все работало
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37320542
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro,
даже не рантайм :(
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37320557
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
> Автор: скукотища
> даже не рантайм :(

Афигеть! 8-)
Мой Excel 2k3 говорит:
Object BrowserSub OpenText(Filename As String, [Origin], [StartRow], [DataType], [TextQualifier As
XlTextQualifier = xlTextQualifierDoubleQuote], [ConsecutiveDelimiter], [Tab], [Semicolon], [Comma], [Space], [Other],
[OtherChar], [FieldInfo], [TextVisualLayout], [DecimalSeparator], [ThousandsSeparator], [TrailingMinusNumbers], [Local])
Member of Excel.Workbooks

Может у тебя Workbooks где-то перекрывается или птичка слетела с Microsoft Excel 11.0 Object Library в референсах?
Попробуй
Код: plaintext
Set wb = Application.Workbooks.OpenText(....


Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37320561
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro,
из браузера объектофф:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
Sub OpenText( 
    Filename As String, 
    [Origin], 
    [StartRow], 
    [DataType], 
    [TextQualifier As XlTextQualifier = xlTextQualifierDoubleQuote], 
    [ConsecutiveDelimiter], 
    [Tab], 
    [Semicolon], 
    [Comma], 
    [Space], 
    [Other], 
    [OtherChar], 
    [FieldInfo], 
    [TextVisualLayout], 
    [DecimalSeparator], 
    [ThousandsSeparator], 
    [TrailingMinusNumbers], 
    [Local])

    Member of Excel.Workbooks
И никаких половых контактов намёков на ссылку на добавленную книгу. Вот такие пироги.
Так что
Код: plaintext
Set wb = Workbooks(Workbooks.Count)
не такое уж извращение.
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37320569
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Игорь Горбонос,
Ссылки на VBA for App, Excel 11 obj lab живые и здоровые.

Игорь Горбонос...
Попробуй

Set wb = Application.Workbooks.OpenText(....попробовал. Ошибка та же.
ЗЫ: пробовал на двух разных машинах.

ЗЗЫ: данную ситуацию абшыбочной не считаю. Это Шокер дразнится.
...
Рейтинг: 0 / 0
помогите с ошибкой
    #37320628
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
скукотищаЗЗЫ: данную ситуацию абшыбочной не считаю. Это Шокер дразнится.хихи, вот я лоханулся.... насоветовал в предыдущем топике черти что
...
Рейтинг: 0 / 0
33 сообщений из 33, показаны все 2 страниц
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / помогите с ошибкой
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]