Dim dbe As Object 'DAO.DBEngine Dim db As Object 'DAO.Database Dim rst As Object 'DAO.Recordset Dim i As Long
Set dbe = CreateObject("DAO.DBEngine.120") Set db = dbe.OpenDatabase("C:\Test.accdb") Set rst = db.TableDefs("Таблица1").OpenRecordset
For i = 1 To Range("A" & Cells.Rows.Count).End(xlUp).Row - 1 rst.AddNew rst("Поле1").Value = Range("a" & 1 + i).Value rst("Поле2").Value = Range("b" & 1 + i).Value rst("Поле3").Value = Range("c" & 1 + i).Value rst.Update Next
End Sub
[/vba]
Необходимо подправить его таким образом, чтобы перед импортом данных из excel в access, он проверял есть ли в таблице access строки, в которых первая и вторая ячейка совпадают с импортируемыми и в этом случае, только обновлял значение третьей ячейки, не добавляя новую строку.
Буду очень признателен.
Всем привет.
Есть макрос:
[vba]
Код
Sub fromExcelToAccess()
Dim dbe As Object 'DAO.DBEngine Dim db As Object 'DAO.Database Dim rst As Object 'DAO.Recordset Dim i As Long
Set dbe = CreateObject("DAO.DBEngine.120") Set db = dbe.OpenDatabase("C:\Test.accdb") Set rst = db.TableDefs("Таблица1").OpenRecordset
For i = 1 To Range("A" & Cells.Rows.Count).End(xlUp).Row - 1 rst.AddNew rst("Поле1").Value = Range("a" & 1 + i).Value rst("Поле2").Value = Range("b" & 1 + i).Value rst("Поле3").Value = Range("c" & 1 + i).Value rst.Update Next
End Sub
[/vba]
Необходимо подправить его таким образом, чтобы перед импортом данных из excel в access, он проверял есть ли в таблице access строки, в которых первая и вторая ячейка совпадают с импортируемыми и в этом случае, только обновлял значение третьей ячейки, не добавляя новую строку.
nick812, привет. Для того чтоб было более понятно что откуда и куда и было на чем протестить, приложите два своих файла ексель и акцес (кроме того, это необходимо делать согласно правил форума).
nick812, привет. Для того чтоб было более понятно что откуда и куда и было на чем протестить, приложите два своих файла ексель и акцес (кроме того, это необходимо делать согласно правил форума).DJ_Marker_MC
Прикладываю excel файл, в третьем столбце количество, и вот оно как раз может измениться, его то и надо обновлять в access при совпадении первых двух полей (Дата, Название)
access файл сюда выложить не удалось (более 100 кб), его положил по ссылке Удалено. нарушение Правил форума [moder]Файл можно заархивировать[/moder]
Исправился, приложил архив с файлом.
DJ_Marker_MC, извиняюсь, что сразу не выложил.
Прикладываю excel файл, в третьем столбце количество, и вот оно как раз может измениться, его то и надо обновлять в access при совпадении первых двух полей (Дата, Название)
access файл сюда выложить не удалось (более 100 кб), его положил по ссылке Удалено. нарушение Правил форума [moder]Файл можно заархивировать[/moder]
Скорее всего, ошибка возникает из-за того, что у вас первое поле - дата. В Excel нет отдельного типа "дата", а вот в акцессе... Нужно либо делать приведение к единому формату (т.е., например, и из рекордсета, и из ячейки - к однотипной строке), либо рыть на предмет представления констант даты используемый движок DAO и используемую версию офиса. Чтобы правильно сформировать строку параметров поиска для rst.findfirst
Ну или вообще сделать ход конём (если все действия должны именно исполняться на стороне Excel) - считать таблицу из базы акцесса целиком в отдельный лист/диапазон рабочей книги, затем сравнить эти два диапазона (ваш и скачанный) только средствами Excel, и сформировать новый набор данных, а затем одним движением полностью заменить содержимое таблицы в базе акцесса.
А, да, ещё - вы точно уверены, что в базе данных у вас всё именно так и называется - Таблица1, Поле1, Поле2,.. ?
Скорее всего, ошибка возникает из-за того, что у вас первое поле - дата. В Excel нет отдельного типа "дата", а вот в акцессе... Нужно либо делать приведение к единому формату (т.е., например, и из рекордсета, и из ячейки - к однотипной строке), либо рыть на предмет представления констант даты используемый движок DAO и используемую версию офиса. Чтобы правильно сформировать строку параметров поиска для rst.findfirst
Ну или вообще сделать ход конём (если все действия должны именно исполняться на стороне Excel) - считать таблицу из базы акцесса целиком в отдельный лист/диапазон рабочей книги, затем сравнить эти два диапазона (ваш и скачанный) только средствами Excel, и сформировать новый набор данных, а затем одним движением полностью заменить содержимое таблицы в базе акцесса.
А, да, ещё - вы точно уверены, что в базе данных у вас всё именно так и называется - Таблица1, Поле1, Поле2,.. ?AndreTM
Skype: andre.tm.007 Donate: Qiwi: 9517375010
Сообщение отредактировал AndreTM - Суббота, 02.05.2015, 03:09
AndreTM, по поводу даты было предположение, но так и не проверил его, так как сделал в access, все поля текстовые. А насчет кода, то вот, что вышло, в рабочем варианте, выкладываю здесь вдруг кому пригодиться:
[vba]
Код
Sub fromExcelToAccess()
Dim dbe As Object 'DAO.DBEngine Dim db As Object 'DAO.Database Dim rst As Object 'DAO.Recordset Dim i As Long
Set dbe = CreateObject("DAO.DBEngine.120") Set db = dbe.OpenDatabase("C:\Test.accdb") Set rst = db.OpenRecordset("select * from Таблица1", 2) 'dbopendynaset
For i = 1 To Range("A" & Cells.Rows.Count).End(xlUp).Row - 1 rst.findfirst "Поле1='" & Range("a" & 1 + i).Value & "' And Поле2='" & Range("b" & 1 + i).Value & "'" If rst.nomatch Then rst.AddNew rst("Поле1").Value = Range("a" & 1 + i).Value rst("Поле2").Value = Range("b" & 1 + i).Value rst("Поле3").Value = Range("c" & 1 + i).Value Else rst.Edit rst("Поле3").Value = Range("c" & 1 + i).Value End If rst.Update Next MsgBox "Готово!" End Sub
[/vba]
AndreTM, по поводу даты было предположение, но так и не проверил его, так как сделал в access, все поля текстовые. А насчет кода, то вот, что вышло, в рабочем варианте, выкладываю здесь вдруг кому пригодиться:
[vba]
Код
Sub fromExcelToAccess()
Dim dbe As Object 'DAO.DBEngine Dim db As Object 'DAO.Database Dim rst As Object 'DAO.Recordset Dim i As Long
Set dbe = CreateObject("DAO.DBEngine.120") Set db = dbe.OpenDatabase("C:\Test.accdb") Set rst = db.OpenRecordset("select * from Таблица1", 2) 'dbopendynaset
For i = 1 To Range("A" & Cells.Rows.Count).End(xlUp).Row - 1 rst.findfirst "Поле1='" & Range("a" & 1 + i).Value & "' And Поле2='" & Range("b" & 1 + i).Value & "'" If rst.nomatch Then rst.AddNew rst("Поле1").Value = Range("a" & 1 + i).Value rst("Поле2").Value = Range("b" & 1 + i).Value rst("Поле3").Value = Range("c" & 1 + i).Value Else rst.Edit rst("Поле3").Value = Range("c" & 1 + i).Value End If rst.Update Next MsgBox "Готово!" End Sub
Для дат, так же нашел решение, т.е. когда в access, тип данных в ячейке - дата и время.
[vba]
Код
Sub fromExcelToAccess()
Dim dbe As Object 'DAO.DBEngine Dim db As Object 'DAO.Database Dim rst As Object 'DAO.Recordset Dim i As Long
Set dbe = CreateObject("DAO.DBEngine.120") Set db = dbe.OpenDatabase("C:\Test.accdb") Set rst = db.OpenRecordset("select * from Таблица1", 2) 'dbopendynaset
For i = 1 To Range("A" & Cells.Rows.Count).End(xlUp).Row - 1 rst.findfirst "Поле1=" & Format(Range("a" & 1 + i).Value, "\#mm\/dd\/yyyy\#") & " And Поле2='" & Range("b" & 1 + i).Value & "'" If rst.nomatch Then rst.AddNew rst("Поле1").Value = Range("a" & 1 + i).Value rst("Поле2").Value = Range("b" & 1 + i).Value rst("Поле3").Value = Range("c" & 1 + i).Value Else rst.Edit rst("Поле3").Value = Range("c" & 1 + i).Value End If rst.Update Next MsgBox "Готово!" End Sub
[/vba]
Для дат, так же нашел решение, т.е. когда в access, тип данных в ячейке - дата и время.
[vba]
Код
Sub fromExcelToAccess()
Dim dbe As Object 'DAO.DBEngine Dim db As Object 'DAO.Database Dim rst As Object 'DAO.Recordset Dim i As Long
Set dbe = CreateObject("DAO.DBEngine.120") Set db = dbe.OpenDatabase("C:\Test.accdb") Set rst = db.OpenRecordset("select * from Таблица1", 2) 'dbopendynaset
For i = 1 To Range("A" & Cells.Rows.Count).End(xlUp).Row - 1 rst.findfirst "Поле1=" & Format(Range("a" & 1 + i).Value, "\#mm\/dd\/yyyy\#") & " And Поле2='" & Range("b" & 1 + i).Value & "'" If rst.nomatch Then rst.AddNew rst("Поле1").Value = Range("a" & 1 + i).Value rst("Поле2").Value = Range("b" & 1 + i).Value rst("Поле3").Value = Range("c" & 1 + i).Value Else rst.Edit rst("Поле3").Value = Range("c" & 1 + i).Value End If rst.Update Next MsgBox "Готово!" End Sub
У нас есть несколько разных файлов экселя, по содержимому столбцы схожи, но вот расположены они по разному. Возможно ли сделать привязку XML шаблона к названию столбца, чтобы перетащил метки шаблона в нужные места, а не создавал постоянно одинаковую структуру файла
rst("Поле1").Value = Range("a" & 1 + i).Value
У нас есть несколько разных файлов экселя, по содержимому столбцы схожи, но вот расположены они по разному. Возможно ли сделать привязку XML шаблона к названию столбца, чтобы перетащил метки шаблона в нужные места, а не создавал постоянно одинаковую структуру файла
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
