ReSQL.ru
     
powered by simpleCommunicator - 2.0.58     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / как извлечь данные из 2х файлов Excel (VBA)
7 сообщений из 7, страница 1 из 1
как извлечь данные из 2х файлов Excel (VBA)
    #37123530
wizardnn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
wizardnn
Участник
Есть 2 файла Excel.
В каждом из них есть лист "Карточки".
На листах данные.

Хочу с помощью диалога выбора файлов выбрать эти 2 файла, а программка сама бы создала новый файл и скопировала данные (из этих 2-х файлов) на новый лист. А файлы бы потом закрыла и оставила только объединенный файл на экране.

Вот что получилось:
Код: 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.
Dim oExcel As New Excel.Application 'Запускаем Excel
oExcel.Visible = True 'Делаем его видимым

Dim oWbk As Excel.Workbook
Set oWbk = oExcel.Workbooks.Add()  'Создаем новую книгу

Dim oSheet As Excel.Worksheet
Set oSheet = oWbk.Worksheets.Add() ' Создаем новый лист
oSheet.Name = "Сравнение" 'Присваиваем ему имя "Сравнение"


ir =  1 

For i =  1  To  2 
fname = Application.GetOpenFilename("Файл оператора (*.xls), *.xls")     'Путь до n-ой книги
    Dim oExcel1 As New Excel.Application
    oExcel1.Visible = True 'Делаем его видимым
    
    Dim oWbk1 As Excel.Workbook
    Set oWbk1 = oExcel1.Workbooks.Open(fname)
    
    oWbk1.Sheets("Карточки").Range("B3:X10").Copy
    'oWbk.Activate
    oWbk.Sheets("Сравнение").Cells(ir,  2 ).Select
    oWbk.Sheets("Сравнение").Paste
    
    ir = oWbk1.Sheets("Карточки").Range("B3:X10").Rows.Count
    
    oWbk1.Close SaveChanges:=False
    Set oExcel1 = Nothing
    oExcel1.Quit
Next

Криво, наверное, но бесит то, что при закрытии Excel он спрашивает, что делать с буфером обмена, т.к. там что-то есть.
Словом программка должна объединить 2 диапазона ячеек на новый лист в новом файле без вопросов.
Как это можно проще реализовать?
как я уже говорил сам: я написал все явно криво... поэтому прошу вашего совета :)
...
Рейтинг: 0 / 0
18.02.2011, 01:31
| Ответить | Цитировать | Написать  
как извлечь данные из 2х файлов Excel (VBA)
    #37123537
Фотография big-duke
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
big-duke
Участник
wizardnn,

Application.DisplayAlerts = False, потом не забудьте включить обратно.
...
Рейтинг: 0 / 0
18.02.2011, 02:02
| Ответить | Цитировать | Написать  
как извлечь данные из 2х файлов Excel (VBA)
    #37123547
wizardnn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
wizardnn
Участник
спасибо!
...
Рейтинг: 0 / 0
18.02.2011, 02:50
| Ответить | Цитировать | Написать  
как извлечь данные из 2х файлов Excel (VBA)
    #37123553
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
скукотища
Гость
wizardnn,
 
план Б (не предусматривает открытия книг для чтения данных)
Код: 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.
'(!) из всех книг копируем данные с листа [Карточки], диапазон [B3:X10]
Const FROMSHEET$ = "Карточки"
Const FROMRANGE$ = "B3" ' первая якейка диапазона который надо скопировать
Const FROMROWSCOUNT% =  8   ' кол-во строк в диапазоне который надо скопировать
Const FROMCOLSCOUNT% =  23  ' кол-во столбцов в диапазоне который надо скопировать

Dim arr, i%, d%, lngRow&, s$
Dim xl As Excel.Application
Dim w As Excel.Worksheet

Set xl = New Excel.Application ' "запустить" Excel

' диалог выбора файлОВ (можно выбрать несколько), результат выбора - в массив
arr = xl.GetOpenFilename("Файл оператора (*.xls), *.xls",  1 , "Выбери себе ...", , True)

If arr <> False Then ' если что-то выбранно
  
  ' ссылка на первый лист во вновь добавленной книге
  Set w = xl.Workbooks.Add.Worksheets( 1 )
  xl.ScreenUpdating = False
  
  ' данные начнем вставлять с первой строки
  lngRow =  1 
  
  ' цикл по всем выбранным книгам
  For i =  0  To UBound(arr)
    s = arr(i)
    d = InStrRev(s, "\")
    
    ' формула для "первой" ячейки
    ' ='Папка_с_книгой[Имя_книги]ЛистОткудаКопируемДанные!'АдресПервойЯчейкиДиапазонаКоторыйКопируем
    w.Cells(lngRow,  1 ).Formula = "='" & Left(s, d) & "[" & Mid(s, d +  1 ) & "]" & FROMSHEET & "'!" & FROMRANGE
    
    ' "протягиваем" формулу вширь и вглубь
    w.Range(w.Cells(lngRow,  1 ), w.Cells(lngRow, FROMCOLSCOUNT)).FillRight
    w.Range(w.Cells(lngRow,  1 ), w.Cells(lngRow + FROMROWSCOUNT -  1 , FROMCOLSCOUNT)).FillDown
    
    ' начальная строка для вставки данных из следующей книги
    lngRow = lngRow + FROMROWSCOUNT
  Next i
  
  ' освободить память занятую массивом
  Erase arr
  
  ' заменить формулы их значениями
  w.Range(w.Cells( 1 ,  1 ), w.Cells(lngRow -  1 , FROMCOLSCOUNT)).Copy
  w.Range(w.Cells( 1 ,  1 )).PasteSpecial xlPasteValues
  
  ' "загнать" что-то небольшое в буфер обмена
  w.Range(w.Cells( 1 ,  1 )).Copy

  w.Name = "Сравнение" ' переименовать лист
  Set w = Nothing ' обнулить ссылку
  
  xl.ScreenUpdating = True
  xl.Visible = True ' здравствуй, новая книга!
  
  MsgBox "Гатовченка"

Else ' не выбрано ни одного файла
  MsgBox "Не очень-то и хотелось..."
  xl.Quit ' закрыть Excel за ненадобностью
End If

Set xl = Nothing ' обнулить ссылку
...
Рейтинг: 0 / 0
18.02.2011, 03:31
| Ответить | Цитировать | Написать  
как извлечь данные из 2х файлов Excel (VBA)
    #37124313
wizardnn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
wizardnn
Участник
скукотища, спасибо!
Не открывая книги копировать данные через формулу - это интересно, тоже нужно попробовать.
...
Рейтинг: 0 / 0
18.02.2011, 12:45
| Ответить | Цитировать | Написать  
Период между сообщениями больше года.
как извлечь данные из 2х файлов Excel (VBA)
    #38062008
шуба - кот
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
шуба - кот
Гость
Ljudi dobrije, pomogite.
Mne tut preslali obrezanuju smetu, v formate exel, v nej estj toljko objomi rabot, a stoimostj stjorta. Estj li vozmoznotj uznatj kakije tam bili ceni?
...
Рейтинг: 0 / 0
03.12.2012, 00:20
| Ответить | Цитировать | Написать  
как извлечь данные из 2х файлов Excel (VBA)
    #38062176
PlanB
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
PlanB
Участник
шуба - котLjudi dobrije, pomogite.
Mne tut preslali obrezanuju smetu, v formate exel, v nej estj toljko objomi rabot, a stoimostj stjorta. Estj li vozmoznotj uznatj kakije tam bili ceni?нет
...
Рейтинг: 0 / 0
03.12.2012, 09:52
| Ответить | Цитировать | Написать  
7 сообщений из 7, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / как извлечь данные из 2х файлов Excel (VBA)
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
NoSQL.ru       Новости, Чат       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=61&msg=37123547&tid=2175181]:
 0ms
get settings:
 11ms
get forum list:
 14ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 40ms
get topic data:
 12ms
get forum data:
 3ms
get page messages:
 58ms
get tp. blocked users:
 1ms
others: 304ms
total:  451ms
созд. / загр.: 451ms
x
x
Закрыть


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