Эксель

Ребята, нужна помощь.

Дано: 2 таблицы в разных файлах, на скрине я их примеры поместил, для удобства на один лист.

В левой таблице мы видим дату действия в рамках события, того кто это действие сделал и для удобства номер этого действия (в оригинале может быть не уникальным, но не суть)

В правой таблице мы видим даты начала и окончания события, участника этого события.

Необходимо: понять совершал ли участник события действия во временном диапазоне события. Т.е если дата в столбце А находится между датами в столбцах F и G И данные в столбцах B и H равны, то данные из столбца C необходимо подставить в столбец I в строчку с участником.

Пробовал сам гуглить и курить форумы, пробовал комбинировать ВПР с ЕСЛИ, но либо не осилил либо не туда копал, а сроки жмут.

По сути ВПР по 2-м условиям, но усложняет то что одним из условий является не точное совпадение, а то что одна ячейка должна быть больше одной и меньше другой (речь про столбцы А, F и G).

Ссылка на файлик-пример https://disk.yandex.ru/i/V1bwJZ5SHyHGvA.

Всё то же самое делаем с другой таблицей. Главное, чтоб выходной файл имел другое название.

2. Создаём MDB-файл

Dim strSQL As String

Dim dbs As DAO.Database, rst As DAO.Recordset, qdf As DAO.QueryDef

Dim strMDB As String

Dim WShell

Set WShell = CreateObject("WScript.shell")

strMDB = WShell.ExpandEnvironmentStrings("%temp%") & "\mdb.mdb"

If FileExists(strMDB) Then Kill strMDB

If CreateDataBaseDAO(strMDB) Then

Set dbs = DAO.OpenDatabase(strMDB)

'создаём таблицу и поля

Set tdf = dbs.CreateTableDef("t1")

Set fld1 = tdf.CreateField("f1", dbText, 255)

tdf.Fields.Append fld1

Set fld1 = tdf.CreateField("f2", dbText, 255)

tdf.Fields.Append fld1

dbs.TableDefs.Append tdf

'создадим запрос на копирование строчек из файла в базу и выполним его

Set qdf = dbs.CreateQueryDef("q1", "insert into t1 SELECT * FROM [Лист1$] AS s_ IN '" & strFile1 & "'[EXCEL 8.0;HDR=no;];")

qdf.Execute

Так же создаём и заполняем столько таблиц, сколько нам надо связать в запросе.

И делаем простенький запрос на выборку со связыванием:

strSQL = "SELECT t1.F1, t1.F2, t2.F1 " & vbCrLf & _

"FROM t1 LEFT JOIN dst ON t1.F1 = t2.F1 " & vbCrLf & _

"WHERE t1.F1 Is Not Null AND t2.F1 Is Null;"

Set qdf = dbs.CreateQueryDef("qCompare", strSQL)

Set rst = dbs.OpenRecordset("qCompare")

If Not rst.EOF Then

While Not rst.EOF

'Debug.Print rst.Fields(0), rst.Fields(1)

rst.MoveNext

Wend

End If

Таким образом формируется запрос, в котором вывелись записи из первой таблицы, для которых не нашлось сопоставление во второй. Можем в цикле вывести эти записи в нашу книгу, например.

В коде встречаются две функции. Вот их код:

Function FileExists(strFile As String) As Boolean

On Error GoTo erro

If FileLen(strFile) <> 0 Then FileExists = True

Exit Function

erro:

If Err.Number = 53 Then FileExists = False

End Function

Function CreateDataBaseDAO(newDB As String, Optional sLocate As String = dbLangCyrillic, Optional iVersion As Integer = dbVersion40) As Boolean

Dim dbNew As Database

On Error GoTo Proc_Err

Set dbNew = DBEngine.CreateDatabase(newDB, sLocate, iVersion)

CreateDataBaseDAO = True

Proc_Exit:

Exit Function

Proc_Err:

MsgBox Err.Description, , Err.Number

CreateDataBaseDAO = False

Resume Proc_Exit

End Function

Самая затратная по времени выполнения часть - это копирование записей из файлов в базу. Это приходится делать, т.к. Jet не считает экселевские файлы полноценным источником данных, не может работать с ними непосредственно через связь, и не может по ним строить индексы и вести нормальный поиск. Может только последовательный перебор от начала до конца файла, что нам совсем не удобно. А вот работа с объектами самого акцесса имеет вполне вменяемое быстродействие. В принципе самое быстрое на данный момент среди файловых баз данных.