Cоздание БД из N-го кол-ва однотипных файлов Excel (>1000) - VB

Узнай цену своей работы

Формулировка задачи:

Здравствуйте, коллеги. Изначальная задача. которая реализовалась - создание БД из N-го кол-ва однотипных файлов Excel (>1000). Модуль написан и работает. Трудность заключается в том, что выгружает данные он с 1го листа в книге, а необходимо загружать с листа с определенным названием, а лист этот не всегда присутствует в книге. Прошу gjlcrfpfnm rfr дополнить модуль функцией проверки наличия в книге листа с заданным именем и вставить в тело программы комманду о соответствующей проверке и выгрузке данных, если лист есть. За основу можно взять лист "Заемщик". С программированием знаком, но с VBA не сталкивался, а во времени ограничен. Буду благодарен за понимание и Ваше время.

Решение задачи: «Cоздание БД из N-го кол-ва однотипных файлов Excel (>1000)»

textual
Листинг программы
Sub ReadFiles_()
    Dim fs As Object, xl As Object, v_Path As String, i As Long
    Dim j As Byte
    '
    Range("a4:p" & Rows.Count).ClearContents
    Range("a4:p4") = Array("Файл", "Отделение", "Сума кредиту", "Срок кредиту міс.", "Щомісячний платіж", "Ціль кредиту", "% ставка", "Прізвище", "Ім'я", "По батькові", "Дата народження", "Стать", "Відношення до армії", "Громадянин України", "Серія", "Номер")
    v_Path = Range("a3") ' путь к исходным файлам
    Set fs = Application.FileSearch
    Set xl = CreateObject("Excel.application")
    fs.LookIn = v_Path
    fs.Filename = "*.xls" ' мака файлов
     If fs.Execute > 0 Then
        For i = 1 To fs.FoundFiles.Count
            xl.DisplayAlerts = False
            xl.Workbooks.Open fs.FoundFiles(i)
            For j = 1 To xl.Sheets.Count
                If xl.Sheets(j) = "Заемщик" Then
                    With xl.Sheets(j)
                        Range(Cells(i + 4, 2), Cells(i + 4, 16)) = _
                            Array(.Range("a1"), .Range("g6"), .Range("g7"), .Range("g8"), .Range("g9"), .Range("g10"), .Range("g12"), .Range("g13"), .Range("g14"), .Range("g15"), .Range("g16"), .Range("g17"), .Range("q16"), .Range("g20"), .Range("g15"))
                        Cells(i + 4, 1) = fs.FoundFiles(i)
                    End With
                    xl.Workbooks(1).Close
                    Exit For
                End If
            Next j
        Next i
        xl.Quit
     End If
    Set fs = Nothing
    Set xl = Nothing
End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

15   голосов , оценка 4.067 из 5
Похожие ответы