ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Код VBA
14 сообщений из 14, страница 1 из 1
Код VBA
    #33783437
DenDY
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
DenDY
Участник
Посмотрите, в чем косяк. Когда доходит до строчки ActiveSheet.Paste
Выдает ошибку, типа команда завершена но с ошибкой. Почему????
ich = InputBox("", "")
For i = 2 To 13
Columns(i).Select
Selection.Copy
Sheets("01." & TextBox1.Value).Select
If i = 2 Then
Range("F" & ich).Select
ActiveSheet.Paste
Range("H" & ich).Select
ActiveSheet.Paste
End If
If i = 3 Then
Range("C" & ich).Select
ActiveSheet.Paste
End If
If i = 4 Then
Range("L" & ich).Select
ActiveSheet.Paste
End If
If i = 5 Then
Range("M" & ich).Select
ActiveSheet.Paste
End If
If i = 6 Then
Range("K" & ich).Select
ActiveSheet.Paste
Range("D" & ich).Select
ActiveSheet.Paste
End If
If i = 8 Then
Range("I" & ich).Select
ActiveSheet.Paste
End If
If i = 9 Then
Range("E" & ich).Select
ActiveSheet.Paste
End If
If i = 11 Then
Range("G" & ich).Select
ActiveSheet.Paste
End If
If i = 13 Then
Range("J" & ich).Select
ActiveSheet.Paste
End If
Sheets("Temp").Select
Next i
...
Рейтинг: 0 / 0
09.06.2006, 14:26:18
| Ответить | Цитировать | Написать  
Код VBA
    #33783458
DenDY
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
DenDY
Участник
Думаю следует добавить.
ДАнные сначала копируются на лист TEMP, оттуда, по приведенной выше процедуре
они вставляются в лист, который и требуется. ДАнные вставляются, но ошибка то появляется. ??? Вот в этом и загадка, почему есть ошибка?
...
Рейтинг: 0 / 0
09.06.2006, 14:32:34
| Ответить | Цитировать | Написать  
Код VBA
    #33783661
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
Код: 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.
Sub f()
    Dim ich As Long, nis As Long
    Dim mySh As String
    Sheets("Temp").Select
    mySh = "01." & Sheets("Temp").TextBox1.Value
    ich = Val(InputBox("", ""))
    For i =  2  To  13 
        nis = Cells(Rows.Count, i).End(xlUp).Row
        If i =  2  Then
            Range(Cells( 1 , i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("F" & ich)
            Range(Cells( 1 , i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("H" & ich)
        End If
        If i =  3  Then Range(Cells( 1 , i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("C" & ich)
        If i =  4  Then Range(Cells( 1 , i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("L" & ich)
        If i =  5  Then Range(Cells( 1 , i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("M" & ich)
        If i =  6  Then
            Range(Cells( 1 , i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("K" & ich)
            Range(Cells( 1 , i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("D" & ich)
        End If
        If i =  8  Then Range(Cells( 1 , i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("I" & ich)
        If i =  9  Then Range(Cells( 1 , i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("E" & ich)
        If i =  11  Then Range(Cells( 1 , i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("G" & ich)
        If i =  13  Then Range(Cells( 1 , i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("J" & ich)
    Next i
End Sub
попробуй
...
Рейтинг: 0 / 0
09.06.2006, 15:18:03
| Ответить | Цитировать | Написать  
Код VBA
    #33791716
DenDY
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
DenDY
Участник
Спасибо vkodor.
Код клевый. Особено определения числа строк. НО есть неточности. строку
mySh = "01." & Sheets("Temp").TextBox1.Value
слдует правильно рассматривать как
mySh = "01." & TextBox1.Value
Далее. И самое главное. При выполенении строки
Range(Cells(1, i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("F" & ich)
Что фактически первая строка цикла выдается ошибка, что метод копирования завершен неверно. Вот такая фигня.
Почему он с одного листа не может то скопировать на другой?
...
Рейтинг: 0 / 0
15.06.2006, 07:19:44
| Ответить | Цитировать | Написать  
Код VBA
    #33791813
DenDY
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
DenDY
Участник
Это весь код. Хедп че то говорит про открытые книги, типа говорит что ошибка неверного завершения может быть если идет попытка открытия 5 книги, хотя реально открыто 3. ПОМОГИТЕЕЕЕЕЕЕ!!!!!

Sheets("01." & TextBox1.Value).Select
pos = 10
While Cells(pos, 1) <> ""
pos = pos + 1
Wend
ich = pos

Sheets.Add
ActiveSheet.Name = "Temp"

With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=C:\Vek" _
, _
"sel\ðååñòð ïî ñîáñòâåííûì âåêñåëÿì.xls;Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLE" _
, _
"DB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global P" _
, _
"artial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False" _
, _
";Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Je" _
, "t OLEDB:SFP=False"), Destination:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("'Îáùèé ___$'")
.Name = "ðååñòð ïî ñîáñòâåííûì âåêñåëÿì"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = _
"C:\Documents and Settings\Denis Dyagilev\Ðàáî÷èé ñòîë\Veksel\ðååñòð ïî ñîáñòâåííûì âåêñåëÿì.xls"
.Refresh BackgroundQuery:=False
End With

Range("A1:X1").Select
Selection.ClearContents
Columns("R:R").Select
Selection.AutoFilter Field:=1, Criteria1:="=Ó", Operator:=xlAnd
Columns("B:B").Select
'Selection.AutoFilter Field:=1, Criteria1:=">=01." & TextBox1.Value, Operator:=xlAnd _
' , Criteria2:="<=31." & TextBox1.Value

Dim mySh As String

mySh = "01." & TextBox1.Value
For i = 2 To 13
nis = Cells(Rows.Count, i).End(xlUp).Row
If i = 2 Then
Range(Cells(1, i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("F" & ich)
Range(Cells(1, i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("H" & ich)
End If
If i = 3 Then Range(Cells(1, i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("C" & ich)
If i = 4 Then Range(Cells(1, i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("L" & ich)
If i = 5 Then Range(Cells(1, i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("M" & ich)
If i = 6 Then
Range(Cells(1, i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("K" & ich)
Range(Cells(1, i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("D" & ich)
End If
If i = 8 Then Range(Cells(1, i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("I" & ich)
If i = 9 Then Range(Cells(1, i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("E" & ich)
If i = 11 Then Range(Cells(1, i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("G" & ich)
If i = 13 Then Range(Cells(1, i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("J" & ich)
Next i


End Sub
...
Рейтинг: 0 / 0
15.06.2006, 08:56:10
| Ответить | Цитировать | Написать  
Код VBA
    #33791852
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
DenDYСпасибо vkodor.
Код клевый. Особено определения числа строк. НО есть неточности. строку
mySh = "01." & Sheets("Temp").TextBox1.Value
слдует правильно рассматривать как
mySh = "01." & TextBox1.Value
Далее. И самое главное. При выполенении строки
Range(Cells(1, i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("F" & ich)
Что фактически первая строка цикла выдается ошибка, что метод копирования завершен неверно. Вот такая фигня.
Почему он с одного листа не может то скопировать на другой?
Код: plaintext
Sheets("Temp").TextBox1.Value
это я написал для понимания того, что TextBox1 может находится где угодно
и лутше ссылаться по полному
Код: plaintext
TextBox1.Value
это тоже самое что и
Код: plaintext
ActiveSheet.TextBox1.Value
ActiveSheet - это активный лист в данный момент и как понимаешь он может быть любым в ходе выполнения программы
теперь про ошибку
Код: plaintext
Range(Cells( 1 , i), Cells(nis, i)).Copy Destination:=Sheets(mySh).Range("F" & ich)
сработает только когда активный лист Sheets("Temp")
если хчешь универсальности то надо делать так

Код: 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.
Sub f()
    Dim ich As Long, nis As Long
    Dim mySh As String
    Dim mySh1 As Worksheet, mySh2 As Worksheet
    Set mySh1 = Sheets("Temp")
    mySh = "01." & Sheets("01.a5").TextBox1.Value
    Set mySh2 = Sheets(mySh)
    ich = Val(InputBox("", ""))
    For i =  2  To  13 
        nis = mySh1.Cells(Rows.Count, i).End(xlUp).Row
        If i =  2  Then
            mySh1.Range(mySh1.Cells( 1 , i), mySh1.Cells(nis, i)).Copy Destination:=mySh2.Range("F" & ich)
            mySh1.Range(mySh1.Cells( 1 , i), mySh1.Cells(nis, i)).Copy Destination:=mySh2.Range("H" & ich)
        End If
        If i =  3  Then mySh1.Range(mySh1.Cells( 1 , i), mySh1.Cells(nis, i)).Copy Destination:=mySh2.Range("C" & ich)
        If i =  4  Then mySh1.Range(mySh1.Cells( 1 , i), mySh1.Cells(nis, i)).Copy Destination:=mySh2.Range("L" & ich)
        If i =  5  Then mySh1.Range(mySh1.Cells( 1 , i), mySh1.Cells(nis, i)).Copy Destination:=mySh2.Range("M" & ich)
        If i =  6  Then
            mySh1.Range(mySh1.Cells( 1 , i), mySh1.Cells(nis, i)).Copy Destination:=mySh2.Range("K" & ich)
            mySh1.Range(mySh1.Cells( 1 , i), mySh1.Cells(nis, i)).Copy Destination:=mySh2.Range("D" & ich)
        End If
        If i =  8  Then mySh1.Range(mySh1.Cells( 1 , i), mySh1.Cells(nis, i)).Copy Destination:=mySh2.Range("I" & ich)
        If i =  9  Then mySh1.Range(mySh1.Cells( 1 , i), mySh1.Cells(nis, i)).Copy Destination:=mySh2.Range("E" & ich)
        If i =  11  Then mySh1.Range(mySh1.Cells( 1 , i), mySh1.Cells(nis, i)).Copy Destination:=mySh2.Range("G" & ich)
        If i =  13  Then mySh1.Range(mySh1.Cells( 1 , i), mySh1.Cells(nis, i)).Copy Destination:=mySh2.Range("J" & ich)
    Next i
End Sub
...
Рейтинг: 0 / 0
15.06.2006, 09:27:44
| Ответить | Цитировать | Написать  
Код VBA
    #33791861
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
Код: plaintext
        "sel\ðååñòð ïî ñîáñòâåííûì âåêñåëÿì
я если копирую когда раскладка клавиатуры на русском, то нет такой абракадабры.
...
Рейтинг: 0 / 0
15.06.2006, 09:33:00
| Ответить | Цитировать | Написать  
Код VBA
    #33794416
DenDY
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
DenDY
Участник
Sheets("01." & TextBox1.Value).Select
pos = 10
While Cells(pos, 1) <> ""
pos = pos + 1
Wend
ich = pos


Workbooks.Open ("Ðååñòð ïî ñîáñòâåííûì âåêñåëÿì.xls")

Range("A:X").Copy
ActiveWorkbook.Close

Sheets.Add
ActiveSheet.Name = "Temp"

Sheets("Temp").Select

Здесь копируются данные с другой книгни. Сразу скажу. что программно вставить никак не получается. Я хз почему. ВЫдает ошибку все время что метод или обект не поддерждивается. ЗАхожу в книгу и просто нажимаю вставить (завершив выполнение кода и сразу все копируется. То есть в буфере олбмена записи есть. Как вставить вопрос??
...
Рейтинг: 0 / 0
16.06.2006, 07:45:27
| Ответить | Цитировать | Написать  
Код VBA
    #33794697
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
если тебе нужны только значения (т.е. без форматов), то не обязательно
пользоваться методом "Copy". можно так
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
Sub prt()
    Dim xlAp As New Excel.Application
    Dim xlWb As Excel.Workbook
    Dim mySh As Worksheet
    Dim rng1 As Range, rng2 As Range
    
    Set xlWb = xlAp.Workbooks.Open("C:\proba.xls", , True) '?aano? ii nianoaaiiui aaenaeyi.xls", , True)
    Set rng1 = xlWb.Sheets(1).Range("A:X")
    Set mySh1 = ActiveWorkbook.Sheets.Add
    mySh1.Name = "Temp"
    Set rng2 = mySh1.Range("A:X")
    rng2.Value = rng1.Value
    
    Set rng1 = Nothing
    Set rng2 = Nothing
    Set mySh1 = Nothing
    xlWb.Close False
    Set xlWb = Nothing
    xlAp.Quit
    Set xlAp = Nothing
End Sub
...
Рейтинг: 0 / 0
16.06.2006, 10:14:39
| Ответить | Цитировать | Написать  
Код VBA
    #33795802
DenDY
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
DenDY
Участник
При таком варианте остается проблема. При копировании поля которое находиться в тестовом формате но там находиться число типа 6723694573289553 когда копируется это число становиться 672369457000000000. Как избежать преобразования типа данных??
...
Рейтинг: 0 / 0
16.06.2006, 14:42:07
| Ответить | Цитировать | Написать  
Код VBA
    #33795958
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
DenDYПри таком варианте остается проблема. При копировании поля которое находиться в тестовом формате но там находиться число типа 6723694573289553 когда копируется это число становиться 672369457000000000. Как избежать преобразования типа данных??
это не проблема
решается одной строчкой
Код: plaintext
rng2.NumberFormat = "@"
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
Sub prt()
    Dim xlAp As New Excel.Application
    Dim xlWb As Excel.Workbook
    Dim mySh As Worksheet
    Dim rng1 As Range, rng2 As Range
    
    Set xlWb = xlAp.Workbooks.Open("C:\proba.xls", , True) '?aano? ii nianoaaiiui aaenaeyi.xls", , True)
    Set rng1 = xlWb.Sheets(1).Range("A:X")
    Set mySh1 = ActiveWorkbook.Sheets.Add
    mySh1.Name = "Temp"
    Set rng2 = mySh1.Range("A:X")
    rng2.NumberFormat = "@"
    rng2.Value = rng1.Value
    Set rng1 = Nothing
    Set rng2 = Nothing
    Set mySh1 = Nothing
    xlWb.Close False
    Set xlWb = Nothing
    xlAp.Quit
    Set xlAp = Nothing
End Sub
...
Рейтинг: 0 / 0
16.06.2006, 15:23:10
| Ответить | Цитировать | Написать  
Код VBA
    #33796048
DenDY
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
DenDY
Участник
Клево, Работает. Спасибо. А что за формат она ставит?
...
Рейтинг: 0 / 0
16.06.2006, 15:44:17
| Ответить | Цитировать | Написать  
Код VBA
    #33796205
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
DenDYКлево, Работает. Спасибо. А что за формат она ставит?
текстовый
...
Рейтинг: 0 / 0
16.06.2006, 16:18:42
| Ответить | Цитировать | Написать  
Код VBA
    #33798625
DenDY
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
DenDY
Участник
Dim fil As Variant
Sheets.Add
fil = Application.GetOpenFilename(" Файлы Excel (*.txt),*.txt", 1, "Выберете файл")
If IsNull("Fil") = True Then Exit Sub
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & fil, _
Destination:=Range("A10"))
.Name = "05СВ_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1251
.TextFileStartRow = 10
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(11, 15, 11, 12, 14, 16, 13, 16, 14, 12, 12, 24, 40)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Columns("B:B").ColumnWidth = 8.71
Columns("L:L").ColumnWidth = 16.29
Columns("L:L").Select
Selection.NumberFormat = "0"
Selection.ColumnWidth = 18.43
Selection.ColumnWidth = 20.57
Selection.ColumnWidth = 22.14
Range("F5").Select
ActiveCell.FormulaR1C1 = "По состоянию на 01." & TextBox1.Value
Range("F2").Select
ActiveCell.FormulaR1C1 = "Журнал регистрации собственных векселей"
ActiveSheet.Name = "01." & TextBox1.Value
Range("A8:A9").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlDistributed
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
ActiveCell.FormulaR1C1 = "ID"
With ActiveCell.Characters(Start:=1, Length:=2).Font
.Name = "Arial"
.FontStyle = "обычный"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

У меня 2 кнопки. А вот при таком коде (тут считаывет из текстового файла данные) как сделать чтобы формат данных был текстовый?
...
Рейтинг: 0 / 0
19.06.2006, 08:49:18
| Ответить | Цитировать | Написать  
14 сообщений из 14, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Код VBA
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=61&tid=2184745]:
 0ms
get settings:
 6ms
get forum list:
 11ms
check forum access:
 2ms
check topic access:
 2ms
track hit:
 38ms
get topic data:
 8ms
get forum data:
 2ms
get page messages:
 36ms
get tp. blocked users:
 1ms
others: 238ms
total:  344ms
созд. / загр.: 344ms
x
x
Закрыть


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