ArtemijG
Member | Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Всем Здрасте! С наступающим. У меня возникла проблема. Излагаю: Существуют таблицы EXCEL (стандартная с одинаковым количеством строк, но каждый раз с разным количеством рядков). Мне надо:
1) Импортировать ее в ACCESS. Это я делаю следующим макросом.
Option Compare Database
Public PathN As String
Public XlApp As Object
Public Wbk As Object
Public BD As DAO.Database
Public rs As DAO.Recordset
Public SQL As String
Public Function OpenDB() As Boolean
On Error GoTo m01
Set BD = CurrentDb
OpenDB = True
Exit Function
m01:
OpenDB = False
End
End Function
Sub Downloader()
PathN = CurrentProject.Path
If OpenDB = False Then Exit Sub
Dim FName As String
Dim NumFile As Integer
NumFile = 0
FName = Dir("*.xls")
Do While FName <> ""
If FileOpen(FName) Then
NumFile = NumFile + 1
Debug.Print FName, NumFile
End If
FName = Dir
Loop
BD.Close
End Sub
Function FileOpen(FName As String) As Boolean
On Error Resume Next
Dim ErrTxt As String
Dim Index As Long, endcells As Long
Dim StartCells As Integer, ListStart As Integer
Index = 0
ErrTxt = ""
Set rs = BD.OpenRecordset("input")
Set XlApp = CreateObject("Excel.Application")
Set Wbk = XlApp.Workbooks.Open((FName), False, ReadOnly)
i1 = 2
i = i1
ListStart = 1
lastrw = Selection.SpecialCells(xlCellTypeLastCell).Row
j = i1
While Wbk.Sheets(1).Cells(j, 2) <> 0
If Wbk.Sheets(1).Cells(j, 1) <> "" Then
rs.AddNew
rs!Код = Wbk.Sheets(1).Cells(j, 1)
rs!МФО = Wbk.Sheets(1).Cells(j, 2)
rs!ОР = Wbk.Sheets(1).Cells(j, 3)
rs!Назначение_счёта = Wbk.Sheets(1).Cells(j, 4)
rs!Результат = Wbk.Sheets(1).Cells(j, 5)
rs!January = Wbk.Sheets(1).Cells(j, 6)
rs!Expense = Wbk.Sheets(1).Cells(j, 7)
rs.Update
j = j + 1
End If
Wend
Wbk.Close SaveChanges:=False
XlApp.Quit
FileOpen = True
End Function
Таблицы ACCESS и EXCEL одинаковы по всем параметрам, только в ACCESS больше столбиков(месяца года)
А теперь что оно делает. Я помещаю в папку "мои документы" 25 файлов EXCEL. Данный макрос перебирает их поочерёдно и наполняет таблицу ACCESS данными. Как бы элементарно.
Но возникала у меня вторая необходимость. После того как данные импортированы, у меня появляется вторая группа файлов EXCEL(за другой месяц) которую снова надо экспортировать в ACCESS, но в этот раз данные должны поместится в другой столбец (February)ACCESS. Сравнение происходит по двум полям, тоесть если совпал поле МФО и ОР данные заносятся в Февраль, если не совпали тогда записываются после последнего заполненного рядка. Данный макрос у меня реализован в EXCEL. Всё очень просто потому как у меня идёт сравнение значений ячеек между двумя листами.Привожу пример кода в EXCEL.
Sub Ôàêò_1602_2007()
Dim MyStr, a, Response
Dim i, i1, i2, i3, ikmF, iMs, j As Integer
ikmF = 12 + (Cells(4, 4) - 1) * 8 + Cells(5, 4) * 2 ' Çì_ùåííÿ äî êîëîíêè ïîòî÷íîãî ì_ñÿöÿ
iMs = (Cells(4, 4) - 1) * 3 + Cells(5, 4) ' íîìåð ïîòî÷íîãî ì_ñÿöÿ
Response = MsgBox("Çàâàíòàæåííÿ ôàêòè÷íèõ äàíèõ çà " & Str(iMs) & " ì_ñÿöü..." & Chr(13) & Chr(10) _
& "ÁÄ â_äñîðòîâàíà ïî ÌÔÎ + ÎÐ ?!!!", vbYesNo)
If Response = vbNo Then GoTo m_end ' User chose No.
i1 = 10
i2 = Cells(8, 3) ' Ê_íåöü ÁÄ
i = i1
j = 6
While Worksheets("Input").Cells(j, 2) <> 0
Cells(1, 4) = j
M1: For i = i1 To i2
If Cells(i, 1) = Worksheets("Input").Cells(j, 2) Then ' MFO=
If Cells(i, 2) = Worksheets("Input").Cells(j, 3) Then ' OR=
Cells(8, 4) = i
Cells(i, ikmF) = Worksheets("Input").Cells(j, 10) 'ôàêò íà çâ_òíó äàòó
i1 = i + 1
GoTo M4 ' Next input
Else
If Cells(i, 2) > Worksheets("Input").Cells(j, 3) Then GoTo M3 ' Insert
GoTo M5 ' Next DB
End If
End If
If Cells(i, 1) > Worksheets("Input").Cells(j, 2) Then GoTo M3
'GoTo m5 ' Next DB
M5: Next i
' Âñòàâêà ñòð_÷êè - Cells(8, 3)
M3: i3 = Cells(8, 3) + 1
Cells(8, 4) = i3
Cells(i3, 1) = Worksheets("Input").Cells(j, 2)
Cells(i3, 2) = Mid(Worksheets("Input").Cells(j, 3), 1, 14)
Cells(i3, 3) = Mid(Worksheets("Input").Cells(j, 3), 9, 2)
Cells(i3, 4) = Worksheets("Input").Cells(j, 1)
Cells(i3, 5) = Worksheets("Input").Cells(j, 4)
Cells(i3, ikmF) = Worksheets("Input").Cells(j, 10) 'ôàêò
Cells(8, 3) = i3
M4: j = j + 1
Wend
m_end:
End Sub
Но в ACCESS понятие ячейки отсутствует. Что делать? Помогите. Всех с наступающим! |
))