ReSQL.ru
     
powered by simpleCommunicator - 2.0.54     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Открытие или перенос данных из dbf файла в Excel макросом
7 сообщений из 32, страница 2 из 2
  2  все
Открытие или перенос данных из dbf файла в Excel макросом
    #37530353
Semennuch
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Semennuch
Гость
В принципе намутил вот так:
Код: 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.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
 Private Sub Perenos()

'Перенос даних з 3-х файлів (Держ.бюд., Місц.бюд., Обл.Бюд.) папки I:\IN\BANK\F412\ до
'відповідних вкладок в Budjetu.xls

 
    Sheets("DerBud").Select
    Columns("B:H").Select
    Selection.ClearContents
    Sheets("MiscBud").Select
    Columns("B:H").Select
    Selection.ClearContents
    Sheets("OblBud").Select
    Columns("B:H").Select
    Selection.ClearContents
    Sheets("Zagalna").Select
    Range("I7").Select





iDate = Application.InputBox("Число", , "15")
iMounth = Application.InputBox("Місяць", , "11")
If iDate = "10" Then iDate = "A"      '
If iDate = "11" Then iDate = "B"      '
If iDate = "12" Then iDate = "C"      '
If iDate = "13" Then iDate = "D"      '
If iDate = "14" Then iDate = "E"      '      '
If iDate = "15" Then iDate = "F"      '      '
If iDate = "16" Then iDate = "G"      '      '
If iDate = "17" Then iDate = "H"      '      '
If iDate = "18" Then iDate = "I"      '
If iDate = "19" Then iDate = "J"      '
If iDate = "20" Then iDate = "K"      '      '      'Прописування дат
If iDate = "21" Then iDate = "L"      '
If iDate = "22" Then iDate = "M"      '
If iDate = "23" Then iDate = "N"      '      '
If iDate = "24" Then iDate = "O"      '      '
If iDate = "25" Then iDate = "P"      '      '
If iDate = "26" Then iDate = "Q"      '      '
If iDate = "27" Then iDate = "R"      '
If iDate = "28" Then iDate = "S"      '
If iDate = "29" Then iDate = "T"      '
If iDate = "30" Then iDate = "U"      '
If iDate = "31" Then iDate = "V"      '

If iMounth = "10" Then iMounth = "A"      '
If iMounth = "11" Then iMounth = "B"      '      'Прописування місяців
If iMounth = "12" Then iMounth = "C"      '



iDerBud = "FT010" & iMounth & iDate & "0.002"   'Файл Державного бюджету
iMiscBud = "FT110" & iMounth & iDate & "0.002"  'Файл Місцевого бюджету
iOblBud = "FT110" & iMounth & iDate & "0.001"   'Файл Обласного бюджету

iFullNameDB = "I:\IN\BANK\F412\" & iDerBud      'Повне ім"я Державного бюджету для перевірки наявності файлів


If iDerBud = Dir(iFullNameDB) Then

ChDir "I:\IN\BANK\F412"
    Workbooks.Open Filename:="I:\IN\BANK\F412\" & iDerBud ' Відкриття файлу з Державним бюджетом
    
    Columns("A:G").Copy                 '
    Windows("Budgetu.xls").Activate     '
    Sheets("DerBud").Select             '
    Columns("B:H").Select               '  'Копіювання даних бюджету у форму Ексель
    ActiveSheet.Paste                   '
    Windows(iDerBud).Activate           '
    ActiveWindow.Close                  '



ChDir "I:\IN\BANK\F412"
    Workbooks.Open Filename:="I:\IN\BANK\F412\" & iMiscBud ' Відкриття файлу з Місцевим бюджетом
    
    Columns("A:G").Copy                 '
    Windows("Budgetu.xls").Activate     '
    Sheets("MiscBud").Select             '
    Columns("B:H").Select               '  'Копіювання даних бюджету у форму Ексель
    ActiveSheet.Paste                   '
    Windows(iMiscBud).Activate           '
    ActiveWindow.Close                  '
ChDir "I:\IN\BANK\F412"

    Workbooks.Open Filename:="I:\IN\BANK\F412\" & iOblBud ' Відкриття файлу з Обласним бюджетом

    Columns("A:G").Copy                 '
    Windows("Budgetu.xls").Activate     '
    Sheets("OblBud").Select             '
    Columns("B:H").Select               '  'Копіювання даних бюджету у форму Ексель
    ActiveSheet.Paste                   '
    Windows(iOblBud).Activate           '
    ActiveWindow.Close
   Else
    MsgBox ("Файли із вказаною датою відсутні")
   
   
End If
Windows("Budgetu.xls").Activate
ActiveWorkbook.Save
End Sub

Это пока промежуточный результат. Со временем, подучусь, узнаю что-то новое и доделаю более хорошим кодом. А пока мне этого хватит. Буду рад, если у кого-то будут рекомендации как усовершенствовать или переделать.
Всем спасибо за внимание и за помощь...
...
Рейтинг: 0 / 0
16.11.2011, 22:18
| Ответить | Цитировать | Написать  
Открытие или перенос данных из dbf файла в Excel макросом
    #37530537
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
скукотища
Гость
Semennuch,
... как усовершенствовать или переделатьЯ бы делал запросами.
 
Код: 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.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
' процедуру  вместе с функцией - в стандартный модуль книги Budjetu.xls
Option Base  0 

Sub fromDBF()
Const sImportDir$ = "I:\IN\BANK\F412"     ' папка с файлами для импорта
Const sTableDBF$ = "import00.dbf"          ' временный файл. обязательные условия:
                                           '  -длина имени не более 8-и символов
                                           '  -расширение 'dbf'

Dim i%
Dim sc$, sq$, sTable$
Dim rs As Object
Dim a, md As Date
Dim sErr$

Application.ScreenUpdating = False

' запрашиваем дату
' при ошибке преобразования введённого значения в дату - молча выходим
On Error Resume Next
  md = CDate(Application.InputBox("Введіть дату", , Day(Date) & "." & Month(Date)))
  If Err.Number Then Exit Sub
On Error GoTo  0 

' "заготовки" шаблонов имен файлов импорта + имена сответствующих листов
a = Array( _
"FT010", "0.002", "DergBud", _
"FT110", "0.001", "OblBud", _
"FT110", "0.002", "MiscBud")

' строка соединения для файлов dBase
sc = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sImportDir & ";" & _
"Extended Properties=dBASE IV;User ID=Admin;Password=;"

' смена текущего диска и каталога на каталог импорта
ChDrive Left$(sImportDir,  1 )
ChDir sImportDir

' обнуление строки сообщения
sErr = ""

' создание объекта Recordset (ADO)
Set rs = CreateObject("adodb.recordset")


For i =  0  To UBound(a) Step  3 
    ' имя файла импорта
    sTable = a(i) & DateToAZ_(md) & a(i +  1 )

    If sTable = Dir(sTable) Then ' no comment
      ' копирование файла импорта во временный файл с кошерным названием
      FileCopy sTable, sTableDBF
   
      sq = "select * from [" & sTableDBF & "]"   ' строка запроса
      rs.Open sq, sc,  0 ,  1 ,  1                     ' открытие набора записей
  
      ' очистка листа и выгрузка записей на лист
      With ThisWorkbook.Worksheets(a(i +  2 ))
        .Columns("B:H").ClearContents
        .Range("B1").CopyFromRecordset rs
      End With

      rs.Close      ' закрытие набора записей
  Else
  ' если файл импорта не найден - формируем строку сообщения
    sErr = sErr & vbCrLf & sTable
  End If

Next i

Set rs = Nothing ' обнуление ссылки на объект
  
  ' проверка результатов импорта, вывод ссответствующего сообщения
  If Len(sErr) >  0  Then
    sErr = "Файли не знайдено: " & sErr
    i = vbExclamation
  Else
    sErr = "імпорт даних за " & md & " закінчено"
    i = vbInformation
  End If
  MsgBox sErr, i, "ІМПОРТ БЮДЖЕТІВ"
  
  ' удаление временного файла
  On Error Resume Next
  Kill sTableDBF
    
Application.ScreenUpdating = True
End Sub

' вспомогательная функция - преобразование даты к "нужному" формату
' rem сам формат даже и не знаю как описать
' rem ничего кроме 'а-ля 1С-подобнЫй 36-ричный' в голову не приходит
Function DateToAZ_$(ByVal d As Date)
Dim s$, i%
    i = Day(d)
    If i <  10  Then s = CStr(i) Else s = CStr(Chr(i +  55 ))
    
    DateToAZ_ = Hex(Month(d)) & s
End Function
...
Рейтинг: 0 / 0
17.11.2011, 01:00
| Ответить | Цитировать | Написать  
Открытие или перенос данных из dbf файла в Excel макросом
    #37530613
Фотография alex77755
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alex77755
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
    Columns("B:H").Select
    Selection.ClearContents
    Sheets("MiscBud").Select
    Columns("B:H").Select
    Selection.ClearContents
    Sheets("OblBud").Select
    Columns("B:H").Select
    Selection.ClearContents
Это лучше делать без селектов. Типа:
Код: plaintext
 Sheets("MiscBud").Columns("B:H").ClearContents
...
Рейтинг: 0 / 0
17.11.2011, 02:41
| Ответить | Цитировать | Написать  
Открытие или перенос данных из dbf файла в Excel макросом
    #37534006
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AndreTM
Участник
Посмотрю, посмотрю...

Три дня без инета сидел - у нас в городе ремонт дорог, и связисты отключили кабель на нашей улочке
А у меня и дом, и офис - все на этом кабеле. Жесть была... На USB-модемах разоришься...
...
Рейтинг: 0 / 0
18.11.2011, 17:35
| Ответить | Цитировать | Написать  
Открытие или перенос данных из dbf файла в Excel макросом
    #37539456
Semennuch
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Semennuch
Гость
скукотища,

Пробовал разобраться с запросами, но мои познания в VB пока ограничены и ничего не получилось. Дальше с хотелкой и литературой должно получиться.

alex77755,

Я потом так и сделал и затраты на выполнение сократились до 7 секунд (всего уходило 40-42 секунды на моей машине).
...
Рейтинг: 0 / 0
22.11.2011, 22:54
| Ответить | Цитировать | Написать  
Открытие или перенос данных из dbf файла в Excel макросом
    #37539541
Фотография С0ВЕСТЬ
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
С0ВЕСТЬ
Участник
Для автоматизации многих задач пользуюсь Automate Enterprise.
Можно глянуть.
...
Рейтинг: 0 / 0
23.11.2011, 00:07
| Ответить | Цитировать | Написать  
Открытие или перенос данных из dbf файла в Excel макросом
    #37539547
Фотография С0ВЕСТЬ
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
С0ВЕСТЬ
Участник
С помощью этой программы, мне на малоавтоматизованном месте удалось много чего автоматизировать.
...
Рейтинг: 0 / 0
23.11.2011, 00:11
| Ответить | Цитировать | Написать  
7 сообщений из 32, страница 2 из 2
  2  все
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Открытие или перенос данных из dbf файла в Excel макросом
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
NoSQL.ru       Новости, Чат       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=60&msg=37539541&tid=2158281]:
 0ms
get settings:
 8ms
get forum list:
 15ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 161ms
get topic data:
 7ms
get forum data:
 2ms
get page messages:
 39ms
get tp. blocked users:
 1ms
others: 354ms
total:  595ms
созд. / загр.: 595ms
x
x
Закрыть


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