Здравствуйте. Столкнулся с проблемой. Есть книга Excel, на первом листе которой перечень этапов договоров со статистикой(КодДоговора, номер этапа и т.д) . Перечень этот берется как основа(по замыслу заказчика данной работы). На второй лист выгружаются данные по этапам из базы данных (Аксесс) - КодДоговора, номер этапа и т.д. Задача состоит вот в чем: сравнить лист 1 и лист 2 и вывести из листа 2 в отдельный лист записи , у которых сочетание КодДоговора+Номер этапа не встречается на листе1.Делал это так(код в обработчике нажатия в Аксесс):
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.
On Error GoTo ErrorHandler
Dim ExportData As Recordset
Dim LastRow, LastRowResult, lastnewJobs As Long
Dim count As Integer 'счетчик совпадений текущей строки листа 2 с листом 1
Dim str1, str2 As String 'договор+этап с листа 1 и с листа 2 соответственно
Dim i, j, k As Integer ' i-счетчик строк листа 1 ,j-счетчик строк листа 2,к - счетчик строк листа 3
k = 2
Me.SubEveryWeekReportGIP.Requery
Set report = CreateObject("Excel.Application")
Set ExportData = Me.SubEveryWeekReportGIP.Form.RecordsetClone
Set Wb = report.Workbooks.Open(report.GetOpenFilename(, , "Выберите файл отчета"))
'Set Wb = report.Workbooks.Open("D:\Еженедельный отчет (2).xlsx")
Set WS = Wb.Sheets(2) ' лист с выгрузкой из БД
Set WSResult = Wb.Sheets(1) ' исходный лист
Set WSNewJobs = Wb.Sheets(3) 'лист с отличающимися записями
LastRow = WS.usedRange.Row + WS.usedRange.Rows.count - 1 'последняя строка листа 2 с данными из БД
lastnewJobs = WSNewJobs.usedRange.Row + WSNewJobs.usedRange.Rows.count - 1 'последняя строка листа 3 с новыми работами
LastRowResult = WSResult.usedRange.Row + WSResult.usedRange.Rows.count - 1''последняя строка листа 1 с исходными данными WSNewJobs.Range("A2:U" & lastnewJobs).Value = ""
WS.Range("A2").CopyFromRecordset ExportData
WS.Rows.RowHeight = 15
WSNewJobs.Rows.RowHeight = 15
For i = 2 To LastRowResult
WSResult.Cells(i, 10) = ""
WSResult.Cells(i, 11) = ""
WSResult.Cells(i, 12) = ""
WSResult.Cells(i, 13) = ""
WSResult.Cells(i, 14) = ""
WSResult.Cells(i, 15) = ""
WSResult.Cells(i, 16) = ""
WSResult.Cells(i, 17) = ""
Next i
For i = 2 To LastRowResult
For j = 2 To LastRow
If (WSResult.Cells(i, 4) = WS.Cells(j, 1)) And (WSResult.Cells(i, 8) = WS.Cells(j, 6)) Then
WSResult.Cells(i, 10) = WS.Cells(j, 8)
WSResult.Cells(i, 11) = WS.Cells(j, 9)
WSResult.Cells(i, 12) = WS.Cells(j, 10)
WSResult.Cells(i, 13) = WS.Cells(j, 11)
WSResult.Cells(i, 14) = WS.Cells(j, 12)
WSResult.Cells(i, 15) = WS.Cells(j, 13)
WSResult.Cells(i, 16) = WS.Cells(j, 15)
WSResult.Cells(i, 17) = WS.Cells(j, 16)
WSResult.Cells(i, 14).NumberFormat = "dd/mm/yy;@"
WSResult.Cells(i, 15).NumberFormat = "dd/mm/yy;@"
WSResult.Cells(i, 16).NumberFormat = "dd/mm/yy;@"
WSResult.Cells(i, 17).NumberFormat = "dd/mm/yy;@"
End If
Next j
Next i
'For k = 2 To LastRow
For j = 2 To LastRow '2-й лист с выгрузкой БД
count = 0
str2 = WS.Cells(j, 1).Value & WS.Cells(j, 6).Value
For i = 2 To LastRowResult '1-й лист с исходными данными
str1 = WSResult.Cells(i, 4).Value & WS.Cells(i, 8).Value
'If (report.WorksheetFunction.Trim(WS.Cells(j, 1) <> report.WorksheetFunction.Trim(WsResult.Cells(i, 4))) And (report.WorksheetFunction.Trim(WS.Cells(j, 6)) <> report.WorksheetFunction.Trim(WsResult.Cells(i, 8)))) Then
If str2 = str1 Then
count = count + 1
End If
Next i
If count > 0 Then
WSNewJobs.Cells(k, 1).Value = WS.Cells(j, 1).Value
WSNewJobs.Cells(k, 2).Value = WS.Cells(j, 2).Value
WSNewJobs.Cells(k, 3).Value = WS.Cells(j, 3).Value
WSNewJobs.Cells(k, 4).Value = WS.Cells(j, 4).Value
WSNewJobs.Cells(k, 5).Value = WS.Cells(j, 5).Value
WSNewJobs.Cells(k, 6).Value = WS.Cells(j, 6).Value
WSNewJobs.Cells(k, 7).Value = WS.Cells(j, 7).Value
WSNewJobs.Cells(k, 8).Value = WS.Cells(j, 8).Value
WSNewJobs.Cells(k, 9).Value = WS.Cells(j, 9).Value
WSNewJobs.Cells(k, 10).Value = WS.Cells(j, 10).Value
WSNewJobs.Cells(k, 11).Value = WS.Cells(j, 11).Value
WSNewJobs.Cells(k, 12).Value = WS.Cells(j, 12).Value
WSNewJobs.Cells(k, 13).Value = WS.Cells(j, 13).Value
WSNewJobs.Cells(k, 14).Value = WS.Cells(j, 14).Value
WSNewJobs.Cells(k, 15).Value = WS.Cells(j, 15).Value
WSNewJobs.Cells(k, 16).Value = WS.Cells(j, 16).Value
WSNewJobs.Cells(k, 11).NumberFormat = "dd/mm/yy;@"
WSNewJobs.Cells(k, 12).NumberFormat = "dd/mm/yy;@"
WSNewJobs.Cells(k, 13).NumberFormat = "dd/mm/yy;@"
WSNewJobs.Cells(k, 14).NumberFormat = "dd/mm/yy;@"
WSNewJobs.Cells(k, 15).NumberFormat = "dd/mm/yy;@"
WSNewJobs.Cells(k, 16).NumberFormat = "dd/mm/yy;@"
k = k + 1
End If
Next j
'Next k
report.Visible = True
ExitHere:
On Error Resume Next
' тут мы закрываем открытые объекты и делаем прочие завершающие вещи
Exit Sub
ErrorHandler:
' вызываем собственно обработчик с записью ошибок
'Err_Routine
'Err_Routine Err.Number, Err.Description, Erl, "Form_Load", "FormsModule"
Resume ExitHere
End Sub
В результате на лист 3 ничего не выводится, хотя на 2-м листе есть записи, которых нет на листе 1. Что я не так делаю ? помогите пожалуйста. |
