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

灬_锦。·° · 发表于 2021-6-16 17:45

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

检查文件.rar (158.83 KB, 下载次数: 4)

3190496160 · 发表于 2021-6-17 10:46

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 · 发表于 2021-6-17 10:47

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

		自动登录	找回密码
密码			免费注册