求助VBA多条TXT转换成EXCEL文件

Jerry6455

我这有多条TXT文件也有多调EXCEL文件，想要把多条的TXT文件，转换成EXCEL格式，也就是多条TXT批量转换成EXCEL文件

在批量的EXCEL文件转换成带有制表符分割的文本文件
我把表格2中所有的加了保护，只有月工资这个列表是可以改动的，请问，是否能用VBA制作出用文本文件，调制出加保护的EXCEL文件，只有月工资是无保护状态的。谢谢，也许我表达的不完善。

3190496160

表述确实是有问题的
看前两段文字，似乎是要实现excel文件和txt文件的互相转换，
但是，后面又把人弄得一头雾水

gwjkkkkk

Sub TEST()
    Dim strFilename$, strPath$, wkb As Workbook
    Dim vResult, arr, brr, strTxt$, i&, j&
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    strPath = ThisWorkbook.Path & "\"
    strFilename = Dir(strPath & "*.txt")
   
    Do Until strFilename = ""
        strTxt = ReadFromText(strFilename)
        arr = Split(strTxt, vbLf)
        ReDim vResult(0 To UBound(arr), 0 To 6)
        For i = 0 To UBound(arr)
           If ReplaceEmptytxt(arr(i)) <> "" Then
           brr = Split(arr(i), vbTab)
            For j = 0 To UBound(brr)
               vResult(i, j) = "'" & brr(j)
            Next j
           End If
        Next i
        Set wkb = Workbooks.Add
        With wkb
           .Sheets(1).[A1].Resize(i, j) = vResult
           .SaveAs ThisWorkbook.Path & "\" & Left(strFilename, InStrRev(strFilename, ".") - 1)
           With .Sheets(1).[A1].CurrentRegion
                .HorizontalAlignment = xlCenter
                .Borders.LineStyle = xlContinuous
                .Rows(1).Font.Bold = True
                .EntireColumn.AutoFit
                .EntireRow.AutoFit
           End With
           .Sheets(1).Columns(5).Locked = False
           .Sheets(1).Protect
           .Close True
        End With
        strFilename = Dir
    Loop
   
    Set wkb = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Beep
End Sub
Function ReadFromText(ByVal FullName As String, Optional CharSet As Integer = -2) As String
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.OpenTextFile(FullName, 1, False, CharSet)
      ReadFromText = f.Readall()
      f.Close
    Set f = Nothing
    Set fs = Nothing
End Function
Function ReplaceEmptytxt(emptytxt)
    Set reg = CreateObject("VBScript.RegExp")
    With reg
      .Global = True
      .IgnoreCase = True
      .Pattern = "[\u0001\u0009\u000a\u000d\u001c-\u0020\u007f-\u00fe]"
      ReplaceEmptytxt = .Replace(emptytxt, "")
    End With
End Function

gwjkkkkk

请楼主参考附件。。。

Jerry6455

3190496160 发表于 2022-12-12 17:19
表述确实是有问题的
看前两段文字，似乎是要实现excel文件和txt文件的互相转换，
但是，后面又把人弄得一 ...

不好意思啊，对，上面说的是两者之间的互换，但有附加条件
1、TXT文件批量转换成EXCEL文件，需要把EXCEL转换好的文件设置成带有保护的，只有一列月工资是不被保护的。这样说能明白吗？如果VBA不能这样处理的话，可以批量处理就可以。
2、EXCEL文件批量转换成TXT，附加条件必须是带制表符分隔的文本文件。

Jerry6455

gwjkkkkk 发表于 2022-12-12 20:25
请楼主参考附件。。。

你好，提示了这个Set f = fs.OpenTextFile(FullName, 1, False, CharSet)
应该是没有找到此文件吧。

Jerry6455

gwjkkkkk 发表于 2022-12-12 20:23
Sub TEST()
    Dim strFilename$, strPath$, wkb As Workbook
    Dim vResult, arr, brr, strTxt$, i&, ...

你好，老师，我可以加你私信吗？

gwjkkkkk

Jerry6455 发表于 2022-12-13 08:22
你好，老师，我可以加你私信吗？

可以的。。。

gwjkkkkk

Jerry6455 发表于 2022-12-13 07:50
你好，提示了这个Set f = fs.OpenTextFile(FullName, 1, False, CharSet)
应该是没有找到此文件吧。

请重新参考附件。。。