Автоматическая проверка в Excel

В настоящее время у меня проблема с проверкой данных в Excel и может стать жертвой «переосмысления» проблемы.

Мои требования просты – я получаю большое количество xls-файлов, которые все должны соответствовать точному формату.

Например, мне нужны все файлы, которые я получаю, чтобы иметь следующие строки в ячейках от A1 до A3: «FirstName», «LastName», «Email». (Дело имеет значение).

В действительности, есть намного больше заголовков, чем это, и траление через каждый файл и обеспечение того, что все заголовки существуют и написаны правильно / в правильном случае очень утомительно и требуют много времени. Я считаю, что можно было бы создать модуль или инструмент в Visual Basic, который мог бы проверить формат, а затем вернуть либо правильный / ложный, основываясь на том, соответствует ли файл требуемому формату.

Я смотрел на регулярные выражения (но считаю, что это может быть излишним, поскольку мне нужны только ТОЧНЫЕ соответствия) и не имеют опыта использования VB. Я посмотрел онлайн на помощь – некоторые из них были полезны, некоторые из которых были слишком продвинуты для инструмента, в котором я нуждаюсь.

Любая помощь приветствуется.

Благодарю.

При использовании Windows выполните следующие действия:

  1. Скопируйте приведенный ниже код в файл и назовите его расширением * .vbs, например. «ExcelHeader.vbs» и сохраните его где-нибудь, например. на рабочем столе
  2. Поместите все ваши файлы Excel, которые вы хотите проверить в заголовках, в папке
  3. Дважды щелкните файл .vbs и выберите эту папку при появлении запроса.

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

(вы также можете изменить приведенный ниже код, чтобы включить больше заголовков, это должно быть очевидно из моих комментариев ниже в разделе «Else If»).

Dim sFolder, fso, files, folder, objExcel, objWorkbook sFolder = SelectFolder( "" ) If sFolder = vbNull Then WScript.Echo "Cancelled" Else WScript.Echo "Selected Folder: """ & sFolder & """" End If ' use strPath to look for excel files list Set fso = CreateObject("Scripting.FileSystemObject") Set folder = fso.GetFolder(sFolder) Set files = folder.Files Set objExcel = CreateObject("Excel.Application") For Each file In files Set objWorkbook = objExcel.Workbooks.Open(file) ' add more headers as you wish as ElseIf statements below If objExcel.Cells(1, 1).Value <> "FirstName" Then MsgBox(file & " is not correct.") ElseIf objExcel.Cells(1, 2).Value <> "LastName" Then MsgBox(file & " is not correct.") ElseIf objExcel.Cells(1, 3).Value <> "Email" Then MsgBox(file & " is not correct.") End If objExcel.ActiveWorkbook.Close(0) Next objExcel.Quit Function SelectFolder( myStartFolder ) ' This function opens a "Select Folder" dialog and will ' return the fully qualified path of the selected folder ' ' Argument: ' myStartFolder [string] the root folder where you can start browsing; ' if an empty string is used, browsing starts ' on the local computer ' ' Returns: ' A string containing the fully qualified path of the selected folder ' ' Written by Rob van der Woude ' http://www.robvanderwoude.com ' Standard housekeeping Dim objFolder, objItem, objShell ' Custom error handling On Error Resume Next SelectFolder = vbNull ' Create a dialog object Set objShell = CreateObject( "Shell.Application" ) Set objFolder = objShell.BrowseForFolder( 0, "Select Folder", 0, myStartFolder ) ' Return the path of the selected folder If IsObject( objfolder ) Then SelectFolder = objFolder.Self.Path ' Standard housekeeping Set objFolder = Nothing Set objshell = Nothing On Error Goto 0 End Function Function ReadExcel( myXlsFile, mySheet, my1stCell, myLastCell, blnHeader ) ' Function : ReadExcel ' Version : 2.00 ' This function reads data from an Excel sheet without using MS-Office ' ' Arguments: ' myXlsFile [string] The path and file name of the Excel file ' mySheet [string] The name of the worksheet used (eg "Sheet1") ' my1stCell [string] The index of the first cell to be read (eg "A1") ' myLastCell [string] The index of the last cell to be read (eg "D100") ' blnHeader [boolean] True if the first row in the sheet is a header ' ' Returns: ' The values read from the Excel sheet are returned in a two-dimensional ' array; the first dimension holds the columns, the second dimension holds ' the rows read from the Excel sheet. ' ' Written by Rob van der Woude ' http://www.robvanderwoude.com Dim arrData( ), i, j Dim objExcel, objRS Dim strHeader, strRange Const adOpenForwardOnly = 0 Const adOpenKeyset = 1 Const adOpenDynamic = 2 Const adOpenStatic = 3 ' Define header parameter string for Excel object If blnHeader Then strHeader = "HDR=YES;" Else strHeader = "HDR=NO;" End If ' Open the object for the Excel file Set objExcel = CreateObject( "ADODB.Connection" ) ' IMEX=1 includes cell content of any format; tip by Thomas Willig objExcel.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _ myXlsFile & ";Extended Properties=""Excel 8.0;IMEX=1;" & _ strHeader & """" ' Open a recordset object for the sheet and range Set objRS = CreateObject( "ADODB.Recordset" ) strRange = mySheet & "$" & my1stCell & ":" & myLastCell objRS.Open "Select * from [" & strRange & "]", objExcel, adOpenStatic ' Read the data from the Excel sheet i = 0 Do Until objRS.EOF ' Stop reading when an empty row is encountered in the Excel sheet If IsNull( objRS.Fields(0).Value ) Or Trim( objRS.Fields(0).Value ) = "" Then Exit Do ' Add a new row to the output array ReDim Preserve arrData( objRS.Fields.Count - 1, i ) ' Copy the Excel sheet's row values to the array "row" ' IsNull test credits: Adriaan Westra For j = 0 To objRS.Fields.Count - 1 If IsNull( objRS.Fields(j).Value ) Then arrData( j, i ) = "" Else arrData( j, i ) = Trim( objRS.Fields(j).Value ) End If Next ' Move to the next row objRS.MoveNext ' Increment the array "row" number i = i + 1 Loop ' Close the file and release the objects objRS.Close objExcel.Close Set objRS = Nothing Set objExcel = Nothing ' Return the results ReadExcel = arrData End Function 

PS Спасибо Rob van der Woude за нижнюю функцию 🙂

Код ниже

  • Открывает каждый файл Excel в папке, указанной strFolderName
  • Запускает тест с одним регистром в первых трех ячейках первого листа и записывает все имена файлов и результаты теста в файл csv «ErrReport.csv» в каталоге objTF.writeline strFileName & "," & (StrComp(StrTest, strArray, vbBinaryCompare) = 0) с objTF.writeline strFileName & "," & (StrComp(StrTest, strArray, vbBinaryCompare) = 0)

    введите описание изображения здесь

     Sub FileChk() Dim Wb As Workbook Dim ws As Worksheet Dim objFSO As Object Dim objTF As Object Dim strFolderName As String Dim strFileName As String Dim strArray As String Dim StrTest As String strFolderName = "c:\temp\" strFileName = Dir(strFolderName & "*.xls*") strArray = Join(Array("FirstName", "LastName", "Email"), ",") Set objFSO = CreateObject("scripting.filesystemobject") Set objTF = objFSO.createtextfile(strFolderName & "ErrReport.csv") With Application .DisplayAlerts = False .EnableEvents = False .ScreenUpdating = False lngCalc = .Calculation .Calculation = xlCalculationManual End With Do While Len(strFileName) > 0 Set Wb = Workbooks.Open(strFolderName & strFileName) Set ws = Wb.Sheets(1) StrTest = Join(Application.Transpose(Range([ws].[a1], ws.[a3]).Value2), ",") objTF.writeline strFileName & "," & (StrComp(StrTest, strArray, vbBinaryCompare) = 0) Wb.Close False strFileName = Dir Loop With Application .CutCopyMode = False .DisplayAlerts = True .EnableEvents = True .ScreenUpdating = True .Calculation = lngCalc End With objTF.Close End Sub 

Ответ vbs ниже, который дает тот же результат, что и Excel VBA выше. После завершения этой версии открывается полный отчет.

 Dim objExcel Dim objFSO Dim objFolder Dim objFile Dim objTF Dim Wb Dim ws Dim strFolderName Dim strArray Dim StrTest Set objExcel = CreateObject("Excel.application") strFolderName = "c:\Temp" strArray = Join(Array("FirstName", "LastName", "Email"), ",") Set objFSO = CreateObject("scripting.filesystemobject") Set objFolder = objFSO.getFolder(strFolderName) Set objTF = objFSO.createtextfile(strFolderName & "ErrReport.csv") With objExcel .DisplayAlerts = False .EnableEvents = False .ScreenUpdating = False End With On Error Resume Next For Each objFile In objFolder.Files 'If Right$(objFile.Name, Len(objFile.Name) - InStrRev(objFile.Name, ".")) Like "xls" Then If Right(objFile.Name, Len(objFile.Name) - InStrRev(objFile.Name, ".")) like "xls*" Then Set Wb = objExcel.Workbooks.Open(objFile) Set ws = Wb.Sheets(1) StrTest = Join(objExcel.Transpose(ws.Range([ws].[a1], ws.[a3]).Value2), ",") objTF.writeline strFileName & "," & (StrComp(StrTest, strArray, vbBinaryCompare) = 0) Wb.Close False End If Next On Error GoTo 0 objTF.Close With objExcel .DisplayAlerts = True .EnableEvents = True .ScreenUpdating = True .Workbooks.Open (strFolderName & "\ErrReport.csv") .Visible = True End With 
  • VBScript сохранит только копию моего файла
  • Приостановить выполнение в Excel VB Script
  • VBS: вытащить файл SQL в Excel
  • VBScipt to Excel - Синтаксис функции диапазона
  • Использование метода UpdateLink () Excel из VBScript
  • Код ошибки: 80040213 Источник CDO.Message.1 Не удалось подключиться
  • Назначение массива в VBS
  • Как я могу ссылаться на встроенный тип MS Excel с OLE
  • Многомерный массив на VBSCRIPT. для вставки в excel
  • VBA Объявление библиотеки и ее динамическая загрузка
  • Мой .xls-документ открывается в яблочных номерах со всеми данными в одном столбце
  • Interesting Posts

    Использование VBA для удаления строки на основе слов, перечисленных на другом листе, – медленная производительность

    Excel: изменить сразу несколько формул?

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

    Создание листа данных Excel из большого файла csv с использованием python (или другого)

    Как преобразовать «A» в Row1Column1 в C #?

    Можно получить доступ к листам, пока выполняется макрос, пока я не нажму кнопку меню

    Подсчет значений значений

    Как превратить строковое значение в пригодные для использования данные из сериализованного файла .xlsx в excel с использованием VBA

    Зацикливание по выбранному диапазону, пытающееся получить значения ячейки со смещением

    Сравнение двух критериев с максимальным значением

    Excel, написанный из списка, очень медленный

    Зачем использовать массивы в VBA, когда есть коллекции?

    Excel VBA – Форматирование «Пятница 27 февраля 08:45:00 CST 2015» в полезную дату

    Вырезать / вставить ячейки на новый лист с определенными критериями

    Сохранить таблицу html в excel

    Давайте будем гением компьютера.