Как скопировать значения из одного файла в другой?

[RomaS]

Добрый день! Спрашивал на форуме прогз, но там ничего не ответили, может тут поможет кто-нибудь?!
Необходимо скопировать данные из дбф в лист эксель в таком виде:
в открытом документе эксель создается новая строка и в первые пять ячеек копируются данные из строки в файле дбф, но нужно поменять местами некоторые ячейки (А10=А10, B10=C10, C10=D10, D10=B10, например так). А в ячейке B10 нужно оставить только первое слово (там стоит фамилия и инициалы, с точками и без, но отделены от фамилии пробелом, нужна только фамилия). И так пока в дбф не кончатся заполненные строки. Пробовал записать макрос мастером в экселе, получается вроде, но работать будет долго (там получилось, что для копирования-вставки каждой строки открывается-закрывается дбф файл), т.к. имеется около 200 строк... очень медленно будет...
Очень надеюсь на Вашу помошь! (Хотя бы по некоторым пунктам)

[Serge_Bliznykov]

Задача разовая? или это нужно будет периодически делать?
я бы рекомендовал Вам такой способ - целиком имортируете (открываете) DBF файл в Excel. Потом переставляете столбцы - их даже можно мышкой перетянуть с одного места на другое (ну, или пишете макрос по перестановке столбцов). Всё.

[VictorM]

В дополнение к сообщению Serge_Bliznykov, хотелось бы только добавить - прикрепляйте хоть небольшой файл с примером того, что Вам нужно сделать. Это намного упростит и ускорит ответ.

[RomaS]

Извините, вот оба файла (реальные данные есс-но, изменены). Надо делать периодически, раз в месяц, пару раз сделал руками - ну очень муторно... а так бы прям клиент и делал сразу все по форме. в дбф есть столбцы с фамилией и инициалами, именем, отчеством, лиц счетом и суммой. вот это и надо переставить местами (согласно столбцам в файле эксель), отфильтровать (я уже писал - удалить инициалы, а поставить имя и отчество), а если на один печатный лист не входит - так еще и для каждого отдельно суммы посчитать и в конце итого.... вот

[Kokain]

Можно подключаться с sql запросом к файлу .dbf из .xls через ADODB (макрос на VBA). Наверняка вы выгружаете dbf из какойто базы (sql server, oracle...), можно будет исполнять запрос к этой базе напрямую (без выгрузки в dbf).

[RomaS]

нет возможности посмотреть даже на ту базу. клиент приносит на дискете реестр уже в файле дбф.

[Teslenko_EA]

Здравствуйте RomaS.
Вашу задачу, конечно же можно решить с помощью Excel,

Код: Выделить всё

Sub Макрос1()
Const sE$ = " "
Dim xlDBF As Object, xl As Object, i&, j&, s$
Set xl = ActiveWorkbook.Worksheets(1) '
Set xlDBF = Workbooks.Open(Filename:="C:\A6.DBF")
    i = 2
    With xlDBF.ActiveSheet
        s = .Cells(i, 6):
        Do
            j = InStr(1, s, sE, 1)
            If j > 0 Then s = Left(s, j - 1)
            s = s & sE & .Cells(i, 20) & sE & .Cells(i, 21)
            xl.Cells(22 + i, 2) = s
            xl.Cells(22 + i, 1) = .Cells(i, 3)
            xl.Cells(22 + i, 3) = .Cells(i, 19)
            xl.Cells(22 + i, 4) = .Cells(i, 18)
            i = i + 1
            s = .Cells(i, 6):
        Loop Until Len(s) = 0
    End With
xlDBF.Close
Set xlDBF = Nothing
...
End Sub

но на мой взгляд, это не его задача, а MS Access.
На сегодняшний день "...имеется около 200 строк..", а завтра возможно их станет больше, таблица DBF не имеет ограничения 65536 записей (строк), которое есть у листа Excel (2003). Отчеты MS Access способны отображать итоговые значения и промежуточные итоги, применяя только SQL запросы, без использования дополнительного кода.
Я думаю если подобная задача у Вас не последняя стоит подумать о MS Access.
Евгений.
P.S. форму которую Вы поместили в свой образец, я делал совсем для других целей. в Вашем случае проще создать новую, чем приспосабливать ее для этой задачи.

[RomaS]

Здравствуйте RomaS.
Вашу задачу, конечно же можно решить с помощью Excel, но на мой взгляд, это не его задача, а MS Access.
На сегодняшний день "...имеется около 200 строк..", а завтра возможно их станет больше, таблица DBF не имеет ограничения 65536 записей (строк), которое есть у листа Excel (2003). Отчеты MS Access способны отображать итоговые значения и промежуточные итоги, применяя только SQL запросы, без использования дополнительного кода.
Я думаю если подобная задача у Вас не последняя стоит подумать о MS Access.
Евгений.
P.S. форму которую Вы поместили в свой образец, я делал совсем для других целей. в Вашем случае проще создать новую, чем приспосабливать ее для этой задачи.

Ваша форма попала в образец случайно - я перед созданием темы просматривал множество тем и образцов, видимо случайно заархивировал не тот файл.
Вы правы, в Access было бы лучше, но я никогда не имел с ним дела, поэтому побыстрому сделал в эксель. Количество строк соответствует числу сотрудников организации. экселя явно достаточно :-) Эта задача уже решена, Эксель документ создан, с формой ввода, настройками, вариантами сохранения готовых файлов, проверкой счетов, постраничной разметкой и прочим-прочим... Хотя, конечно, криво и непрофессионально, но с задачей отлично справляется, что есть главное.
А конкретно по теме, данное действие с подсказки voxel решено так (из этого кода убрал не относящиеся к делу строки):

Код: Выделить всё

 Sub FindDBF() 'поиск файла дбф
Dim FilePath, DBFName As String, ko As Integer
On Error GoTo errr
'отключаем обновление экрана, чтоб быстрее работало
Application.ScreenUpdating = False
'задаем путь к файлам
FilePath = Range("Сервис!Y1").Value
'ищем файлы с расширением dbf по указанному выше пути
DBFName = Dir(FilePath & "*.dbf")
'если ни один файл не найден завершаем процедуру
If DBFName = "" Then GoTo errr
ko = 1
Call copy_r(FilePath, DBFName, ko)


'в цикле ищем файлы
Do While DBFName <> ""

'получаем имя очередного файла
DBFName = Dir

If DBFName = "" Then Exit Do 'если файл не найден завершаем цикл
    
Call copy_r(FilePath, DBFName, ko)

If ko > 2 Or ko = 2 Then
MsgBox ("В папке " & UserForm1.TextBox3 & vbNewLine & vbNewLine & _
"найдено больше одного DBF файла с данными," & vbNewLine _
& "поэтому автоматическое заполнение невозможно! " & vbNewLine _
& "Выполните выбор файла вручную."), vbExclamation, "Уточните имя нужного файла"
new_r
manualopenDBF ' макрос ручного выбора файла
GoTo exx
End If

Loop

exx:
'включаем обновление экрана
Application.ScreenUpdating = True

Exit Sub
errr:
MsgBox ("Не найдено ни одного файла dbf! Проверьте правильность заданного пути к папке с файлами dbf!"), vbCritical, "Не найдены файлы"

End Sub 

Код: Выделить всё

 Function copy_r(FilePath, DBFName, ko) 'обработка файлов
Dim y, sm, m, nsm As Integer
Dim lic, fam, imja, otch, sum, nom As Integer
Dim fio, fiosc, schet, schetsc, tem, temsc, temf As String
ko = 1
'открываем найденный файл
Workbooks.Open (FilePath & DBFName)
If Range("F2").Value <> "" Then 'если файл не пустой

' мне приносили два варианта дбф файлов. поэтому проверяем какому соответствует:
' каждый обрабатываемый столбец, на всякий случай
If Range("A1").Value = "NOMPP" And ....
 Then
nom = 1
fam = 5
imja = 6       ' номера столбцов с нужными данными согласно первому варианту
otch = 7
lic = 2
sum = 3
GoTo obrab
End If

' второй вариант структуры дбф файла
If...Then
...
Else
Workbooks(DBFName).Close
Exit Function
End If

obrab:
ko = ko + 1
DBFName = ActiveWorkbook.name

'определяем количество строк в dbf файле
y = Cells.SpecialCells(xlCellTypeLastCell).Row

'активизируем эту книгу
ThisWorkbook.Sheets("Реестр").Activate

'смещение вниз для вставляемых строк
sm = 22
m = 25

' в цикле копируем данные из dbf в активный лист этой книги
For n = 2 To y
nsm = n + sm

'добавляем строку, форматируем
m = m + 1
Cells(m, 1).EntireRow.Insert
Cells(nsm, 5).NumberFormat = "@"
Cells(nsm, 6).NumberFormat = "@"
Cells(nsm, 7).NumberFormat = "#,##0.00"

For nst = 4 To 8
With Cells(nsm, nst).Borders
       .LineStyle = xlContinuous
       .Weight = xlThin
       .ColorIndex = xlAutomatic
End With
Next

'данные из столбца dbf вставляем в столбец xls
ThisWorkbook.Sheets("Реестр").Cells(nsm, 4).Value = Workbooks(DBFName).ActiveSheet.Cells(n, nom).Value

wd = Split(Workbooks(DBFName).ActiveSheet.Cells(n, fam).Value, " ")

'ставим фамилию, имя, отч в ячейку
On Error Resume Next
fio = wd(0) & " " _
& Workbooks(DBFName).ActiveSheet.Cells(n, imja).Value & " " _
& Workbooks(DBFName).ActiveSheet.Cells(n, otch).Value
ThisWorkbook.Sheets("Реестр").Cells(nsm, 5).Value = fio

'ставим лиц счет....
.........
   Next
End If
........
'закрываем дбф файл
Workbooks(DBFName).Close
......
End Function