Question

execl高手用VBA改写用文本txt错误不要用表格

execl高手用VBA改写用文本txt错误不要用表格
对阳光?

Answer 1

Sub xxx()
    Dim i, j, s, arr
    [c11].CurrentRegion.Select '选择C11开始的连续空间，下面也会输出这块内容
    arr = [c11].CurrentRegion '选择内容转换到数组中
    Open "c:\1.txt" For Output As #1 '建立TXT文件
    For i = LBound(arr) To UBound(arr) '输出每一行
        s = ""
        For j = LBound(arr, 2) To UBound(arr, 2)
            s = s & arr(i, j) & Chr(9)
        Next j
        Print #1, s
    Next i
    Close #1
End Sub

你之前的代码我就不修改了，只把C11开始的内容输出到TXT文件，你试试看吧。

追问

成功了再加

追答

如果需要结果超过6万行的数据，需要使用高版本的EXCEL，并保存文件为XLSX格式。

Answer 2

您好，您这样：
Sub reWriteData()
Dim Fso As Object, oJs As Object
Dim Arr, k%, Fld, Fl

Set oJs = CreateObject("ScriptControl"): oJs.Language = "JScript"
oJs.eval ("function $(s1,s2){var a=(s1+s2).match(/\-*\d+\.\d{5}/g);return s1." _
& "replace(a[1],'-'+(parseFloat(a[2])-parseFloat(a[3])).toFixed(5))};")
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Fld = Fso.getfolder(CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件夹", 0, "").Self.Path & "\")

For Each Fl In Fld.Files
Open Fl For Input As #1
Arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
k = UBound(Arr): Reset
Arr(k - 2) = oJs.eval("$('" & Arr(k - 2) & "','" & Arr(k - 1) & "');")

Open Fl For Output As #1
Print #1, Join(Arr, vbCrLf): Reset
Next
Set oJs = Nothing: Set Fso = Nothing
End Sub