概述

Question

我目前在Excel中遇到数据验证问题，可能是“过度思考”问题的受害者。

我的要求很简单 - 我收到了大量的xls文件，这些文件都需要符合确切的格式。

例如，我需要收到的所有文件在单元格A1到A3中都有以下字符串：“FirstName”，“LastName”，“Email”。（案件很重要）。

实际上，有比这更多的标题，并且遍历每个文件并确保所有标题存在并且拼写正确/在正确的情况下是非常繁琐和耗时的。我相信可以在Visual Basic中创建一个模块或工具，它可以检查格式，然后根据文件是否符合所需的格式返回正确/错误。

我已经研究过正则表达式（但是我认为这可能有点过分，因为我只需要完全匹配）而且没有使用VB的经验。我在网上寻求帮助 - 其中一些是有用的，其中一些对于我需要的工具来说太先进了。

非常感谢任何帮助。

感谢。

Answer 1

以下代码

打开strFolderName

在第一张工作表的前三个单元格上运行单个区分大小写的测试，并将所有文件名和测试结果写入csv文件“ErrReport.csv”< / em>在strFolderName目录中 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

Answer 2

如果您使用的是Windows，请执行以下操作：

将下面的代码复制到一个文件中，并用* .vbs扩展名命名，例如。 “ExcelHeader.vbs”，并保存在某处，例如。在桌面上
将您要检查标题的所有Excel文件放在文件夹中
双击.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 (e.g. "Sheet1")
' my1stCell   [string]   The index of the first cell to be read (e.g. "A1")
' myLastCell  [string]   The index of the last cell to be read (e.g. "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

P.S。感谢Rob van der Woude的底层功能：）

Answer 3

下面的

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

Answer 4

概述

我开始评论上面的VBA答案，但决定单独的答案会更清楚。我开始主要回答Rich的问题＆＃34;我如何实现/运行它？＆＃34;因为这个问题是由没有使用VB的经验的人提出的，＆＃34;一些受访者似乎也处于这个水平。

以下是解决问题的方法：将文件名全部放在一个文件夹中，或将其列在新 Excel主工作表中。将正确的规范标题放在同一主工作表中。然后放入代码以检查此主工作表中的其他工作表。最后，在检查文件后，列出它们是否符合该主工作表。

步骤一步

打开一个新的Excel工作簿以放入您的解决方案。在此空白工作簿中，输入以下项目：
- 在顶部修正标题值，例如，在单元格A1：X1中。
- 要在单个列中检查的文件的文件名，例如，在单元格A6：A60中。优选地，这些文件名应具有指定的完整路径。
- 将单元格保留在文件名为空的右侧，因为它们将被TRUE / FALSE值覆盖。
按 Alt + F11 打开VBA编辑器，在项目浏览器的左侧找到新的工作簿。
- 如果看不到Project Explorer窗格，请按 Ctrl + R 将其打开。
- 如果您打开了多个工作簿，则需要在括号中找到带有工作簿名称的VBAProject，例如 VBAProject（Book1）
- 如果折线，请点击 VBProject 左侧的 + 符号，找到正确的工作簿。
右键单击该工作簿的 VBAProject 上的，或者直接在下面与其关联的任何行，然后选择插入 - ＆gt;的模块即可。这应该在VBA编辑器的主要部分打开一个空白模块区域。
将下面的代码复制并粘贴到该空白模块中。
保存工作簿，可以是.xlsm，.xlsb或.xls文件（不是.xlsx）。
返回工作表（从VBA编辑器中按 Alt + F11 ，或者只需点击电子表格），然后按 Alt + F8 ，然后双击 FileCheck 运行宏。
这将标记符合该标题模式的文件，文件名右侧为TRUE，并在不符合的文件旁标记为FALSE。

代码

#Const AllFilesInFolder = False
#Const SuppScreenUpdate = False             ' Suppress Screen Update

Sub FileCheck()
' Purpose: Verify header content on multiple specified files. Checks headers for each file:
'   1) Listed in this Workbook.Sheet(1) in the range specified by scFilesAddr -- OR --
'   2) All .xls* files in the folder/path specified by scFolderName
' Headers are matched to the values in the range specified by scHeaderAddr

    Dim IsFound As Boolean, DoMatch As Boolean
    Dim nFile As Long, nHeader As Long
    Dim Wkb As Workbook, wks As Worksheet
    Dim rngHdrMaster As Range, rngHdrTest As Range
    Dim rngFilenames As Range, sFileName As String
    #If SuppScreenUpdate Then
    Dim lngCalc As XlCalculation
    #End If

'         HEADERS' RANGE
' --> --> Change this Range address to the required matching headers <-- <--
    Const scHeaderAddr As String = "A1:C1"
    ' This range address should also match up with the headers in the worksheets to test!

    Set rngHdrMaster = ActiveSheet.Range(scHeaderAddr)

'         FILENAMES' RANGE
' --> --> Change this Range address to point to the File names to examine <-- <--
    Const scFilesAddr As String = "A6:A105"
    ' Ideally, all filenames listed should also list the full path, or be in the same
    ' folder as this workbook.

    Set rngFilenames = ActiveSheet.Range(scFilesAddr)
#If AllFilesInFolder Then           ' Get all Excel files in this folder
'         FOLDER PATH
' --> --> Change this Folder name to point to where all files will be examined
    Const scFolderName As String = "C:\Temp\"

    sFileName = Dir(strFolderName & "*.xls*")
    If Len(sFileName) > 0 Then
        sFileName = scFolderName & sFileName
        IsFound = True
    End If
#Else                               ' Get Excel files listed in master spreadsheet
    sFileName = rngFilenames(1).Value
    IsFound = (Len(Dir(sFileName)) > 0)
#End If
    nFile = 1

    #If SuppScreenUpdate Then           ' Optional: Set to True above if it runs slowly
    With Application
        .DisplayAlerts = False
        .EnableEvents = False
        .ScreenUpdating = False
        lngCalc = .Calculation
        .Calculation = xlCalculationManual
    End With
    #End If

    Do While Len(sFileName) > 0     ' If Filename is specified, but File doesn't exist, just
        If IsFound Then             ' skip that file. If Filename is blank, then exit proc.
            Set Wkb = Workbooks.Open(sFileName)
            Set wks = Wkb.Sheets(1)
            Set rngHdrTest = wks.Range(scHeaderAddr)
            DoMatch = True
            For nHeader = 1 To rngHdrMaster.Columns.Count
                If rngHdrMaster(nHeader).Value2 <> rngHdrTest(nHeader).Value2 Then
                    DoMatch = False
                    Exit For
                End If
            Next
            Wkb.Close False

            rngFilenames(nFile, 1).HorizontalAlignment = xlRight
            rngFilenames(nFile, 1).Value = sFileName
            rngFilenames(nFile, 2).HorizontalAlignment = xlCenter
            rngFilenames(nFile, 2).Value = DoMatch              'Could also put Y/N here
            nFile = nFile + 1
            #If AllFilesInFolder Then
                sFileName = Dir()       ' Get next file infolder
            #Else           ' Put value in nFile row, 2nd col - rngFilenames can be 1 col wide.
                ' Uncomment code below to ensure it does not read past specified range
                ' Otherwise, will keep reading values until it finds empty cell-maybe desired?
                'If nFile > ActiveSheet.Range(scFilesAddr).Rows.Count Then
                '    Exit For
                'Else
                    sFileName = rngFilenames(nFile).Value
                    IsFound = (Len(Dir(sFileName)) > 0)
                '    If sFileName = "" Then sFileName = "None"
                'End If
            #End If
        End If
    Loop

    #If SuppScreenUpdate Then
    With Application
        .CutCopyMode = False
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = lngCalc
    End With
    #End If

End Sub             ' FileCheck

设置

您必须定义代码中的某些范围：

对于您想要比较的每个标题，您需要输入主电子表格。然后，您还需要确保在scHeaderAddr常量中输入这些标题的范围地址。例如，如果你有5个标题，你会改变这样的行： Const scHeaderAddr As String = "A1:E1"
如果您需要比较的文件超过100个，请将scFilesAddr常量更改为单个列中具有正确单元格数的范围。 Const scFilesAddr As String = "A6:A105" 另请参阅下面 自定义 下的选择文件名。
如果您要检查文件夹中的所有Excel文件，请参阅 自定义下的检查文件夹中的所有文件部分下面。您还需要将常量 scFolderName 更改为可以找到这些文件的路径。

Const scFolderName As String = "C:\Temp\"＆＃39; 确保以反斜杠结束！

定制

检查文件夹中的所有文件

代码中有一些编译器常量，这是一种高级功能，但它使定制非常容易。如果要检查文件夹中的所有文件，只需将代码顶部的行更改为#Const AllFilesInFolder = True

基本上，当AllFilesInFolder = True时，#If AllFilesInFolder Then ...和... #Else（或...... #End If之间的任何内容，如果#Else缺失）将运行，#Else ...和... #End If之间的任何内容都将被忽略。或 反之亦然，如果是False，则#If AllFilesInFolder Then ...和...之间的任何内容。#Else将被忽略，#Else ...和... #End If之间的任何内容都将运行。< / p>

取消屏幕更新

如果在打开文件等情况下它运行缓慢，请将顶部附近的行更改为#Const SuppScreenUpdate = True。我把它放在那里是因为brettdj将它包含在他的代码中，但它有时会妨碍故障排除。

将文件名限制为范围

最后一次自定义：当前功能将从 scFilesAddr 范围内的第一个单元格开始，在列中继续，并在找到第一个空白时退出单元格，无论是在范围内还是在范围之外。所以从技术上讲，如果你忘了扩大范围，它仍然会找到100多个文件名，只要它们之间没有空白单元格。如果您希望检查范围内的每个单元格是否存在文件名，无论是否有插入的空白单元格，请删除初始单引号（注释掉< / em>）从第132-138行的开头（以'If nFile > ActiveSheet.Range(scFilesAddr).Rows.Count Then开头，以'End If结尾）。

顺便说一下，它确实检查文件是否存在，并且将忽略任何不存在的文件，但它不会停止该过程。

Excel中的自动验证

4 个答案:

概述

步骤一步

代码

设置

定制

检查文件夹中的所有文件

取消屏幕更新

将文件名限制为范围