N个TXT文档中固定字段提取到Excel, 求VBA

tspliu

jone_huang 发表于 2021-8-10 16:22
能否帮忙做个代码呢? 我对VB是一点都不懂

在审核中不要急

wanao2008

tspliu 发表于 2021-8-10 11:33
我下载你的文件用二楼程序试了下，没问题

感谢测试！

jone_huang

wanao2008 发表于 2021-8-10 18:28
感谢测试！

大神, 能依Tspliu最新在你的基础上修改的再加另外三个数据么, 实在是对VB不懂, 一个字都改不了..

直接抄了楼上大神的，另三个数据你也参照弄一下就可以了，思路就是这个思路。
Sub byWanao()
    Dim Filename$, myDir$, myText, mArr() As String, jsNum&
    myDir = Dir(ThisWorkbook.Path & "\*.txt")
    Debug.Print myDir
    Do While myDir <> ""
        Filename = ThisWorkbook.Path & "\" & myDir
        Open Filename For Input As #1
        s = StrConv(InputB(LOF(1), 1), vbUnicode)
        jsNum = Cells(Rows.Count, 1).End(xlUp).Row + 1
        mArr = Split(s, "FF:FF:FF:FF:FF:FF,", , 0)
        For i = 1 To UBound(mArr)
            str1 = Split(mArr(i), ",", , 0)(0)
            Cells(jsNum + i, 1) = "'" + str1
        Next
        Close #1
        myDir = Dir
    Loop
End Sub

jone_huang

tspliu 发表于 2021-8-10 16:11
直接抄了楼上大神的，另三个数据你也参照弄一下就可以了，思路就是这个思路。
Sub byWanao()
    ...

另外三个数据怎么弄, 能否再帮忙一下, 我对VB一点不懂, 看这代码一脸蒙呀.

lsdongjh

见附件吧
提取后格式.rar (20.87 KB, 下载次数: 6)

2021-8-11 14:04 上传

点击文件名下载附件

jone_huang

lsdongjh 发表于 2021-8-11 14:04
见附件吧

十分感谢