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

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

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

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

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

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

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

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

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

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


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