txt文件导入工作表

hhxq001

想把TXT文件里的人员信息导出excel表，方便操作，代码可以搞定吗


导入文本文件.rar (6.78 KB, 下载次数: 23)

2023-6-16 17:50 上传

点击文件名下载附件

gwjkkkkk

数据太少，建议多一些，便于批量导入 。。。。

hhxq001

gwjkkkkk 发表于 2023-6-16 18:22
数据太少，建议多一些，便于批量导入 。。。。

一个TXT文件就这些内容呢，不要批量导入，要一个一个自己选择需要导入的文件，因为将来有的需要更新，有的不更新。

liulang0808

Sub 按钮1_Click()
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = ThisWorkbook.Path & "\"
        .Title = "请选择对应文本文件"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "文本文件", "*.txt"
        If .Show Then f = .SelectedItems(1) Else Exit Sub '
    End With
    str1 = ReadUTF(f)
    arr = Split(str1, "：")
    r = Cells(Rows.Count, 1).End(3).Row + 1
    arr(0) = r - 1
    For j = 1 To UBound(arr)
        arr(j) = Split(arr(j), Chr(10))(0)
    Next j
    Cells(r, 1).Resize(1, UBound(arr) + 1) = arr
    Cells(r, 8) = Split(str1, "￥")(1)
End Sub
Function ReadUTF(ByVal FileName As String) As String
    With CreateObject("ADODB.Stream")
        .Type = 2
        .Mode = 3
        .Open
        .LoadFromFile FileName
        .Charset = "UTF-16"
        .Position = 2
        ReadUTF = .ReadText
        .Close
    End With
End Function

liulang0808

楼主的模拟附件仅有一个，不知道其他txt格式是否与此一致，供参考

hhxq001

liulang0808 发表于 2023-6-17 07:51
楼主的模拟附件仅有一个，不知道其他txt格式是否与此一致，供参考

其余TXT文件，和这一个格式完全一样，所以没有上传其他

hhxq001

liulang0808 发表于 2023-6-17 07:50
Sub 按钮1_Click()
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileNam ...

看不懂，讨教是怎么个过程

liulang0808

hhxq001 发表于 2023-6-17 22:14
看不懂，讨教是怎么个过程

FileDialog打开窗口选择文本文件，然后读取处理，因为编码问题，使用了一个函数