Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Бесконечная работа макроса при объемах больше 100 000 строк. / 12 сообщений из 12, страница 1 из 1
31.07.2013, 17:44
    #38350621
Сергей_Ро
Сергей_Ро
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Бесконечная работа макроса при объемах больше 100 000 строк.
Господа, доброго времени суток.
Есть проблема с макросом, макрос сравнивает первый выбранный файл со следующими двумя выбранными файлами. Результатом являются строки из файла1 которых нет ни файле2 ни в файле3. Проблема в том, что на маленьких объемах(до 10 000 строк) отрабатывает нормально и корректно(хотя иногда и долго минут 15-20). Но если количество строк заваливает за 100 000 то макрос работает бесконечно не выдавая результата. Пробовал оставить на ночь результата не. Нужна помощь в диагностике проблемы, собственно сам код:

Код: vbnet
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.
Sub Compare3Files()
Dim myName As String, wB As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Выберите ПЕРВЫЙ файл для сравнения"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
myName = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Workbooks.Open Filename:=myName: Set wB = Workbooks(ActiveWorkbook.Name)

Dim myName1 As String, wB1 As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Выберите ВТОРОЙ файл для сравнения"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
myName1 = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Workbooks.Open Filename:=myName1: Set wB1 = Workbooks(ActiveWorkbook.Name)

Dim myName2 As String, wB2 As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Выберите ТРЕТИЙ файл для сравнения"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
myName1 = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Workbooks.Open Filename:=myName1: Set wB2 = Workbooks(ActiveWorkbook.Name)

Dim SaveFile As String, sB As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Выберите файл для сохранения"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
SaveFile = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Workbooks.Open Filename:=SaveFile: Set sB = Workbooks(ActiveWorkbook.Name)

Dim i As Long, j As Long, k As Long, Flag As Boolean

i = 1: k = 1
Do While wB.Worksheets(1).Cells(i, 1) <> ""
' Проверяем в 1 файле на 1 листе строки 1-го столбца, от 1 до пустой, то есть до конца таблицы.
   j = 1: n = 1: Flag1 = False: Flag2 = False ' Flag - это признак, что запись из Файла1 есть или нет в Файле2.
   
   Do While wB1.Worksheets(1).Cells(j, 1) <> ""
   ' Проверяем во 2 файле на 1 листе строки 1-го столбца, от 1 до пустой, то есть до конца таблицы.
       If wB.Worksheets(1).Cells(i, 1) = wB1.Worksheets(1).Cells(j, 1) Then Flag1 = True
       ' Нашли запись из Файла1 в Файле2, устанавливаем Flag в True
       j = j + 1
   Loop
   Do While wB2.Worksheets(1).Cells(n, 1) <> ""
   ' Проверяем во 2 файле на 1 листе строки 1-го столбца, от 1 до пустой, то есть до конца таблицы.
       If wB.Worksheets(1).Cells(i, 1) = wB2.Worksheets(1).Cells(n, 1) Then Flag2 = True
       ' Нашли запись из Файла1 в Файле3, устанавливаем Flag в True
       n = n + 1
   Loop
   
   If Flag1 = False And Flag2 = False Then ' Если запись из Файла1 не встретилась в файле1 и файле2, то
       sB.Worksheets(1).Range(Cells(k, 1), Cells(k, 10)).Value = wB.Worksheets(1).Range(Cells(i, 1), Cells(i, 10)).Value
       ' Записываем ее в Файл3
       k = k + 1 ' Переходим на следующую строчку в Файле3
   End If
  i = i + 1
Loop
MsgBox "Выполнение сравнения законченно успешно"
End Sub



Буду очень признателен за помощь, в VBA не профи, сам не разберусь.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
31.07.2013, 18:37
    #38350696
lbppb
lbppb
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Бесконечная работа макроса при объемах больше 100 000 строк.
Сергей_Ро,

1. При работе с отдельно взятыми ячейками, Excel очень сильно тормозит, тем более на большом объеме данных.
2. Ваша задача должна и может выполняться за секунды и поможет вам в этом внутренний запрос SQL. Если не получится разобраться самостоятельно, то пишите, поможем.
3. На будущее, вот это поможет слегка ускорить процесс
Код: vbnet
1.
Application.Calculation = xlCalculationManual
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
31.07.2013, 18:40
    #38350701
lbppb
lbppb
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Бесконечная работа макроса при объемах больше 100 000 строк.
Сергей_Ро,

В догонку, смотря какая версия Excel, но если не ошибаюсь, то до 2007 больше 65 535 строк обрабатывать было нельзя.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
01.08.2013, 07:32
    #38351009
грязный комплектовщик
грязный комплектовщик
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Бесконечная работа макроса при объемах больше 100 000 строк.
lbppbСергей_Ро,
2. Ваша задача должна и может выполняться за секунды и поможет вам в этом внутренний запрос SQL. Если не получится разобраться самостоятельно, то пишите, поможем.

А как в макросе 3 файла указывать? В коннекшнстринг и в запросе?
Если б листы сравнивались в 1 книге - понятно, а тут как?
-----
Не люблю ProgressOpenEdge.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
01.08.2013, 07:58
    #38351015
sergeyvg
sergeyvg
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Бесконечная работа макроса при объемах больше 100 000 строк.
при такой реализации, как минимум, использовать Exit Do
Код: vbnet
1.
2.
3.
       If wB.Worksheets(1).Cells(i, 1) = wB1.Worksheets(1).Cells(j, 1) Then Flag1 = True: Exit Do
...
       If wB.Worksheets(1).Cells(i, 1) = wB2.Worksheets(1).Cells(n, 1) Then Flag2 = True: Exit Do


как вариант использовать Find, пример попробую попозже сваять
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
01.08.2013, 08:30
    #38351027
sergeyvg
sergeyvg
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Бесконечная работа макроса при объемах больше 100 000 строк.
через Find где-то так:
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
wB1.Worksheets(1).Columns("A:A").AutoFit
wB2.Worksheets(1).Columns("A:A").AutoFit
i = 1: k = 1
Do While wB.Worksheets(1).Cells(i, 1) <> ""
  Flag1 = False: Flag2 = False
   
  Set WorkRange = wB1.Worksheets(1).Range("A:A").Find(wB.Worksheets(1).Cells(i, 1), LookIn:=xlValues, LookAt:=xlWhole)
  If Not WorkRange Is Nothing Then Flag1 = True
   
  Set WorkRange = wB2.Worksheets(1).Range("A:A").Find(wB.Worksheets(1).Cells(i, 1))
  If Not WorkRange Is Nothing Then Flag2 = True
   
  If Flag1 = False And Flag2 = False Then
    wB.Worksheets(1).Range(wB.Worksheets(1).Cells(i, 1), wB.Worksheets(1).Cells(i, 10)).Copy _
      Destination:=sB.Worksheets(1).Cells(k, 1)
    k = k + 1
  End If
  i = i + 1
Loop
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
01.08.2013, 09:17
    #38351054
Сергей_Ро
Сергей_Ро
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Бесконечная работа макроса при объемах больше 100 000 строк.
Первый код немного не верный, вот правильный код:

Код: vbnet
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.
Sub Compare3Files()
Dim myName As String, wB As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Выберите ПЕРВЫЙ файл для сравнения"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
myName = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Workbooks.Open Filename:=myName: Set wB = Workbooks(ActiveWorkbook.Name)

Dim myName1 As String, wB1 As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Выберите ВТОРОЙ файл для сравнения"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
myName1 = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Workbooks.Open Filename:=myName1: Set wB1 = Workbooks(ActiveWorkbook.Name)

Dim myName2 As String, wB2 As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Выберите ТРЕТИЙ файл для сравнения"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
myName1 = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Workbooks.Open Filename:=myName1: Set wB2 = Workbooks(ActiveWorkbook.Name)

Dim SaveFile As String, sB As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Выберите файл для сохранения"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
SaveFile = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Workbooks.Open Filename:=SaveFile: Set sB = Workbooks(ActiveWorkbook.Name)

Dim i As Long, j As Long, k As Long, Flag As Boolean
'Dim Sb As Workbook
'Set Sb = Workbooks.Open(Filename:="N:\ОАИТ\SUPER VAZHNO\Тест\Люди.xlsx")

i = 1: k = 1
Do While wB.Worksheets(1).Cells(i, 1) <> ""
' Проверяем в 1 файле на 1 листе строки 1-го столбца, от 1 до пустой, то есть до конца таблицы.
   j = 1: n = 1: Flag1 = False: Flag2 = False ' Flag - это признак, что запись из Файла1 есть или нет в Файле2.
   
   Do While wB1.Worksheets(1).Cells(j, 1) <> ""
   ' Проверяем во 2 файле на 1 листе строки 1-го столбца, от 1 до пустой, то есть до конца таблицы.
       If wB.Worksheets(1).Cells(i, 1) = wB1.Worksheets(1).Cells(j, 1) Then Flag1 = True
       ' Нашли запись из Файла1 в Файле2, устанавливаем Flag в True
       If Flag1 = True Then GoTo 4
       j = j + 1
   Loop
   Do While wB2.Worksheets(1).Cells(n, 1) <> ""
   ' Проверяем во 2 файле на 1 листе строки 1-го столбца, от 1 до пустой, то есть до конца таблицы.
       If wB.Worksheets(1).Cells(i, 1) = wB2.Worksheets(1).Cells(n, 1) Then Flag2 = True
       ' Нашли запись из Файла1 в Файле2, устанавливаем Flag в True
       If Flag2 = True Then GoTo 4
       n = n + 1
   Loop
   
   If Flag1 = False And Flag2 = False Then ' Если запись из Файла1 не встретилась в файле2, то
       wB.Worksheets(1).Range(wB.Worksheets(1).Cells(i, 1), wB.Worksheets(1).Cells(i, 40)).Copy Destination:=sB.Worksheets(1).Cells(k, 1)
       ' Записываем ее в Файл3
       k = k + 1 ' Переходим на следующую строчку в Файле3
   End If
4:   i = i + 1
Loop
MsgBox "Выполнение сравнения законченно успешно"
End Sub



И если можно подскажите где почитать про вложенный запрос SQL?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
01.08.2013, 09:25
    #38351064
Shocker.Pro
Shocker.Pro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Бесконечная работа макроса при объемах больше 100 000 строк.
 
Сергей_Ро
Код: vbnet
1.
Workbooks.Open Filename:=myName: Set wB = Workbooks(ActiveWorkbook.Name)

просто замечание для опыта, метод Open и так возвращает книгу, достаточно написать
Код: vbnet
1.
Set wB = Workbooks.Open(Filename:=myName)
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
01.08.2013, 10:09
    #38351142
скукотища
скукотища
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Бесконечная работа макроса при объемах больше 100 000 строк.
грязный комплектовщикА как в макросе 3 файла указывать? В коннекшнстринг и в запросе?
Если б листы сравнивались в 1 книге - понятно, а тут как?
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
connectionstr = "provider=...;mode=read;extended properties='excel 12.0;hdr=no;imex=2';data source=" & полное_имя_ПЕРВОЙ_книги

querystr = _
"select f1,f2,f3,f4,f5,f6,f7,f8,f9,f10 from [Лист1$] as t1" _
" where not exists (" _
"select f1 from [Лист1$] in 'полное_имя_ВТОРОЙ_книги'[excel 12.0;hdr=no;imex=2]" _
" union all" _
" select f1 from [Лист1$] in 'полное_имя_ТРЕТЬЕЙ_книги'[excel 12.0;hdr=no;imex=2]" _
" where f1 = t1.f1" _
")"
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
01.08.2013, 10:54
    #38351201
Сергей_Ро
Сергей_Ро
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Бесконечная работа макроса при объемах больше 100 000 строк.
Попробовал следующий код:
Код: vbnet
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.
Public Sub Prepare()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Application.DisplayStatusBar = False
End Sub

Public Sub Ended()
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.DisplayStatusBar = True
End Sub



Sub Compare3FilesIZineta()
Prepare
Dim myName As String, wB As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Выберите ПЕРВЫЙ файл для сравнения"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
myName = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Workbooks.Open Filename:=myName: Set wB = Workbooks(ActiveWorkbook.Name)

Dim myName1 As String, wB1 As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Выберите ВТОРОЙ файл для сравнения"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
myName1 = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Workbooks.Open Filename:=myName1: Set wB1 = Workbooks(ActiveWorkbook.Name)

Dim myName2 As String, wB2 As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Выберите ТРЕТИЙ файл для сравнения"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
myName1 = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Workbooks.Open Filename:=myName1: Set wB2 = Workbooks(ActiveWorkbook.Name)

Dim SaveFile As String, sB As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Выберите файл для сохранения"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
SaveFile = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Workbooks.Open Filename:=SaveFile: Set sB = Workbooks(ActiveWorkbook.Name)

Dim i As Long, j As Long, k As Long, Flag As Boolean

wB1.Worksheets(1).Columns("A:A").AutoFit
wB2.Worksheets(1).Columns("A:A").AutoFit
i = 1: k = 1
Do While wB.Worksheets(1).Cells(i, 1) <> ""
  Flag1 = False: Flag2 = False
   
  Set WorkRange = wB1.Worksheets(1).Range("A:A").Find(wB.Worksheets(1).Cells(i, 1), LookIn:=xlValues, LookAt:=xlWhole)
  If Not WorkRange Is Nothing Then Flag1 = True
   
  Set WorkRange = wB2.Worksheets(1).Range("A:A").Find(wB.Worksheets(1).Cells(i, 1))
  If Not WorkRange Is Nothing Then Flag2 = True
   
  If Flag1 = False And Flag2 = False Then
    wB.Worksheets(1).Range(wB.Worksheets(1).Cells(i, 1), wB.Worksheets(1).Cells(i, 10)).Copy _
      Destination:=sB.Worksheets(1).Cells(k, 1)
    k = k + 1
  End If
  i = i + 1
Loop
Ended
MsgBox "Выполнение сравнения законченно успешно"
End Sub



Та же шляпа, залипает на обработке большого количества строк.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
01.08.2013, 13:19
    #38351535
грязный комплектовщик
грязный комплектовщик
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Бесконечная работа макроса при объемах больше 100 000 строк.
Сергей_Ро...
И если можно подскажите где почитать про вложенный запрос SQL к данным экселя?
тут почитать
http://support.microsoft.com/kb/257819/ru
тут сам запрос
14646773
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
02.08.2013, 11:26
    #38352590
Сергей_Ро
Сергей_Ро
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Бесконечная работа макроса при объемах больше 100 000 строк.
Проблема решена использование объектов типа Dictionary, загоняем информацию из файлов в словари и далее работаем со словарями. Макрос отрабатывает за секунды при огромных объемах. Всем спасибо.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Бесконечная работа макроса при объемах больше 100 000 строк. / 12 сообщений из 12, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
созд. / загр.: 547ms
Закрыть
start [/forum/topic.php?fid=61&tablet=1&tid=2174627]:
 0ms
get settings:
 9ms
get forum list:
 13ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 49ms
get topic data:
 47ms
get forum data:
 3ms
get page messages:
 82ms
get tp. blocked users:
 2ms
others: 336ms
total:  547ms
x
x
Закрыть


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