2016-12-03 4 views
0

Сотни xlsx-файлов, проживающих в каталоге, импортируются в базу данных MSAccess 2010 , но пользователи, как обычно, недисциплинированы (нужна бомба ...), поэтому я должен очистите рабочий лист перед импортом. Вопрос: как удалить все строки, у которых нет данных в столбце A и всех столбцах, начиная с O до XFD? Код ниже работает, но только для одного файла времени, благодарен заранее за любую помощь. enter image description here Все красные должны быть удалены.MSAccess VBA для удаления строк и столбцов на листе

Private Sub Comand_Click() 
    Dim FullPath As String 
    Dim oXL As Object, oWb As Object, oWs As Object 
    FullPath = "D:\Access\_Test_XlsImport\FileName.xlsx" 
    Set oXL = CreateObject("Excel.Application") 
    Set oWb = oXL.Workbooks.Open(FullPath) 
    Set oWs = oWb.Sheets("Worksheet_name") 
    oXL.Visible = True 

    With oWs 
     .Columns("O:XFD").Delete 
     .Rows("xx:xx").Delete ' <---problem to identify the starting point to delete below.. 
    End With 
    oWb.Save 

CleanUp: 
    oWb.Close False 
    oXL.Quit 
    Set oWb = Nothing 
    Set oXL = Nothing 
    Set oWs = Nothing 
End Sub 
+0

Вы спрашиваете, как написать цикл? Или как определить первую непустую строку? Как вы определяете «пустой» - вся строка должна быть пустой или конкретной ячейкой в ​​столбце? – dbmitch

+0

Точно мистер dbmitch цикл, который работает для всех резидентных файлов, проживающих в каталоге Заголовок столбца для каждого отдельного файла от A1 до N1 I Проверяем строку на первые 3 символа строки, хранящейся в первой ячейке в столбце A – PhobiaBlu

ответ

0

Я бы вытащил переменную oXL и сделаю ее глобальной для вашего модуля, поэтому вы откроете ее только один раз.

Затем поместите другие объекты Excel в подпрограмму, которая очищает рабочие листы

Что-то, как это должно работать - подменить папку для постоянного Команда DIR только соответствует всем файлам, которые соответствуют XLSX файл спецификации и обрабатывает каждый из них в петле

Просто предупреждение - нет проверки файлов, которые не имеют данных в колонке А - если это произойдет, программа будет продолжаться, пока все строки были исчерпаны.

EDIT - Модифицированный, чтобы удалить все пустые строки вплоть до последней непустой ячейки

Option Compare Database 
Option Explicit 


' Use these as global 
Private oXL As Object 

Private Sub Comand_Click() 

    Const SEARCH_FOLDER  As String = "C:\Databases\" 
    Const EXCEL_FILES  As String = "*.xlsx" 

    Dim FullPath As String 

    Dim strExcelFolder As String 
    Dim strFilename  As String 

    ' Open Excel 
    Set oXL = CreateObject("Excel.Application") 
    oXL.Visible = True 

    strFilename = Dir(SEARCH_FOLDER & EXCEL_FILES) 
    While strFilename <> "" 
     ProcessExcelFile SEARCH_FOLDER, strFilename 
     strFilename = Dir() 
    Wend 

CleanUp: 
    oXL.Quit 
    Set oXL = Nothing 
End Sub 

Private Sub ProcessExcelFile(strExcelFolder As String, strExcelFile As String) 

    Dim oWb As Object, oWs As Object 
    Dim strFullPath As String 

    Dim LastRow As Long 

    strFullPath = strExcelFolder & strExcelFile 
    Set oWb = oXL.Workbooks.Open(strFullPath) 
    Set oWs = oWb.Sheets(1) 

    With oWs 
     LastRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row 

     .Columns("O:XFD").Delete 

     ' Select All rows in Column A up to last filled row 
     .Range(“A1:A" & LastRow).Select 

     ' Delete all rows with empty cell in A - up to last filled row 
     oXL.Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete 

     .Save 
     .Close False 
    End With 

    Set oWb = Nothing 
    Set oWs = Nothing 

End Sub 
+0

Привет, мистер дБ Митч. Я думаю, вы очень близко решаете. Просто время выполнения 438 в этой строке. Установите oWb = oXL.Workbooks.Open (strFullPath). Библиотека Microsoft Access и офисная библиотека 14.0 установлены в ссылках – PhobiaBlu

+0

Удалите «&» \ «» из 'strFullPath = strExcelFolder &" \ "& strExcelFile' - обновленный ответ – dbmitch

+0

Сделано сегодня в офисе Mr dbmitch, ошибка не но ничего не меняется в файлах. Я хочу уточнить, что весь написанный вами код находится под событием «on click». На данный момент тестирование только с одним файлом, проживающим в каталоге – PhobiaBlu

Смежные вопросы