ReSQL.ru
     
powered by simpleCommunicator - 2.0.55     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / помогите с ошибкой
25 сообщений из 33, страница 1 из 2
  1  все
помогите с ошибкой
    #37318834
afrobiba
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
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
21.06.2011, 22:03
| Ответить | Цитировать | Написать  
помогите с ошибкой
    #37318836
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
afrobiba,

подчеркивание потерял в первой строке
...
Рейтинг: 0 / 0
21.06.2011, 22:07
| Ответить | Цитировать | Написать  
помогите с ошибкой
    #37318837
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ципихович Эндрю
Участник
afrobiba
1
что за ошибка
2
есть дома такой файл
...
Рейтинг: 0 / 0
21.06.2011, 22:07
| Ответить | Цитировать | Написать  
помогите с ошибкой
    #37318838
afrobiba
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
afrobiba
Гость
всем спасибо, все свободны!
нашел проблему сам - вспемнил что у него просто офис 2010 а у меня 2007
...
Рейтинг: 0 / 0
21.06.2011, 22:07
| Ответить | Цитировать | Написать  
помогите с ошибкой
    #37318841
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
afrobibaвсем спасибо, все свободны!
нашел проблему сам - вспемнил что у него просто офис 2010 а у меня 2007и как это связано с синтаксической ошибкой?
...
Рейтинг: 0 / 0
21.06.2011, 22:08
| Ответить | Цитировать | Написать  
помогите с ошибкой
    #37318842
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ципихович Эндрю
Участник
Шокер Вам толкует
StartRow:=1, подчёркивание_____________где?
...
Рейтинг: 0 / 0
21.06.2011, 22:08
| Ответить | Цитировать | Написать  
помогите с ошибкой
    #37318846
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ципихович Эндрю
Участник
>все свободны!
, ОК!
...
Рейтинг: 0 / 0
21.06.2011, 22:10
| Ответить | Цитировать | Написать  
помогите с ошибкой
    #37318851
afrobiba
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
afrobiba
Гость
извиняйте, поторопился с выводами!
спасибо за подчеркивание
...
Рейтинг: 0 / 0
21.06.2011, 22:14
| Ответить | Цитировать | Написать  
помогите с ошибкой
    #37318860
afrobiba
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
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
21.06.2011, 22:24
| Ответить | Цитировать | Написать  
помогите с ошибкой
    #37318868
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
скукотища
Гость
afrobiba,
Excel не может найти лист с именем 'on123'
...
Рейтинг: 0 / 0
21.06.2011, 22:33
| Ответить | Цитировать | Написать  
помогите с ошибкой
    #37318870
afrobiba
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
afrobiba
Гость
скукотища,

он есть. точнее это единственный лист в книге.
...
Рейтинг: 0 / 0
21.06.2011, 22:34
| Ответить | Цитировать | Написать  
помогите с ошибкой
    #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
21.06.2011, 22:55
| Ответить | Цитировать | Написать  
помогите с ошибкой
    #37318917
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
скукотища
Гость
... справка врёт
...
Рейтинг: 0 / 0
21.06.2011, 23:14
| Ответить | Цитировать | Написать  
помогите с ошибкой
    #37318926
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
afrobiba выделяет часть "Sheets("on123").Select" и пишет "Error 9: Subscript out of range"и не создает новый лист и не кидает в него строкишота ты гонишь. Новый лист создается как раз ДО того, как в дело вступает указанная строка
...
Рейтинг: 0 / 0
21.06.2011, 23:25
| Ответить | Цитировать | Написать  
помогите с ошибкой
    #37318932
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
скукотища
Гость
Shocker.Pro,
не судите, и не судимы бу (с) Holly Bible

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

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

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

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

нуну
а по делу что-нибудь приложишь?
...
Рейтинг: 0 / 0
22.06.2011, 00:18
| Ответить | Цитировать | Написать  
помогите с ошибкой
    #37319010
afrobiba
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
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
22.06.2011, 00:31
| Ответить | Цитировать | Написать  
помогите с ошибкой
    #37319019
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
скукотища
Гость
afrobiba,
так и не последовали моему совету
В вашей книге НЕТ листа с именем 'on123'. Такой лист есть во вновь созданной книге .
...
Рейтинг: 0 / 0
22.06.2011, 00:51
| Ответить | Цитировать | Написать  
помогите с ошибкой
    #37319046
afrobiba
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
afrobiba
Гость
скукотища,

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

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

Вообще-то, если мне не изменяет память, я тебе уже показывал, как присвоить переменной ссылку на новую книгу и впоследствии к ней обращаться.
...
Рейтинг: 0 / 0
22.06.2011, 01:31
| Ответить | Цитировать | Написать  
помогите с ошибкой
    #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
22.06.2011, 01:55
| Ответить | Цитировать | Написать  
25 сообщений из 33, страница 1 из 2
  1  все
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / помогите с ошибкой
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
NoSQL.ru       Новости, Чат       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=60&msg=37318870&tid=2158602]:
 0ms
get settings:
 9ms
get forum list:
 14ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 55ms
get topic data:
 8ms
get forum data:
 2ms
get page messages:
 62ms
get tp. blocked users:
 2ms
others: 376ms
total:  534ms
созд. / загр.: 534ms
x
x
Закрыть


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