查找文件夹下多个txt文件内容第一列字符是否是11位

灬_锦。·°

小弟有一个需求，就是能否通过excell实现查询某一个文件夹下面的记事本文件是否是标准格式
其中记事本文件标准格式是
01033080115,3320167.65444,497807.89212,26.47215
主要是检查第一个逗号前面的数字是否是11位数，01033080115，一般容易错误的是最后4位0115错误的写成115，然后错误的结果是0103308115，通过表格查询目录下所有的记事本第一列是否是标准的。如果有，能否改过来或者提取出该文件的名字，然后我修改，有一个点号检查的附件是我一个个的复制进来然后添加的辅助表格 检查文件.rar (158.83 KB, 下载次数: 4)

2021-6-16 17:44 上传

点击文件名下载附件

3190496160

Sub 查询异常数据()
Application.ScreenUpdating = False
Dim lines, cols ''定义两个数组
Dim i As Integer, k As Integer ''数值型变量
Dim arr()
ReDim arr(1 To 10000, 1 To 3)
arr(1, 1) = "文件名称"
arr(1, 2) = "数据"
arr(1, 3) = "行号"
f = Dir(ThisWorkbook.Path & "\*.txt")
n = 1
Do While f <> ""
    Open ThisWorkbook.Path & "\" & f For Input As #1 ''打开选择的文本文件
    lines = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf) ''把文本文件的数据赋值给数组lines
    k = UBound(lines) ' + 1 '文件的行数
    '遍历每一行
    Close #1 ''关闭打开的文本文件
    For i = 2 To k ''循环数组行
        If InStr(lines(i), ",") > 0 Then ''判断该行是否有逗号
            cols = Split(lines(i), ",")(0)    '以逗号作为分隔，将每行字符分割，分隔符可根据实际情况自己修改
            sl = Len(Trim(cols))
            If sl <> 11 Then
                n = n + 1
                arr(n, 1) = f
                arr(n, 2) = cols
                arr(n, 3) = i
            End If
        End If
    Next i
f = Dir
Loop
If n = "" Then MsgBox "没有异常数据！": Exit Sub
With Sheets("sheet1")
    .UsedRange.ClearContents ''清空原来的数据
    .Columns("b:b").NumberFormatLocal = "@" ''设置A列为文本格式
    .[a1].Resize(n, 3) = arr
End With
MsgBox "有" & n & "行数据异常"
Application.ScreenUpdating = True
End Sub

3190496160

检查文件.rar (163.85 KB, 下载次数: 2)

2021-6-17 10:47 上传

点击文件名下载附件