请大神帮着解决Excel批量修改数据的问题~~

l516605725

请看下附件，里面有三个Excel文件（另一个副本说明文件），每个文件的数据体格式都是一样的。现在我想把多个（数百）相同格式的Excel批量处理：
1、将A列和L列（即第一列和最后一列）删除。
2、将第一行的表头整体修改（汉字修改为符号），修改结果请看文件（1）的第20行。
     形成的结果请看“(1) - 副本.xls”
3、将Excel另存为文本（.txt）格式，文件名与原Excel文件相同。
最终形成“(1).txt”这样的文件。

请大神不吝赐教，非常感谢~~

yylucke

参考代码
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
    Dim MyPath As String, MyFile, ThisBK, MyArr, s$

    ThisBK = ActiveWorkbook.Name
    MyPath = ThisWorkbook.Path & "\"
    MyFile = Dir(MyPath & "*.xls*")
    Do While MyFile > ""
        If MyFile <> ThisBK Then
            Workbooks.Open Filename:=MyPath & MyFile
            Set c = ActiveWorkbook
            MyArr = c.Sheets("Sheet1").Range("A1").CurrentRegion
            s = "#Depth  ZS      QL      C1      C2      C3      IC4     NC4     NC5     IC5"
            For i = 2 To UBound(MyArr)
                s = s & vbCrLf & MyArr(i, 2) & vbTab & _
                    Format(MyArr(i, 3), "0.0000") & vbTab & _
                    Format(MyArr(i, 4), "0.0000") & vbTab & _
                    Format(MyArr(i, 5), "0.0000") & vbTab & _
                    Format(MyArr(i, 6), "0.0000") & vbTab & _
                    Format(MyArr(i, 7), "0.0000") & vbTab & _
                    Format(MyArr(i, 8), "0.0000") & vbTab & _
                    Format(MyArr(i, 9), "0.0000") & vbTab & _
                    Format(MyArr(i, 10), "0.0000") & vbTab & _
                    Format(MyArr(i, 11), "0.0000")
                Next i
                Open MyPath & Split(c.Name, ".")(0) & ".txt" For Output As #1
                Print #1, s
                Close #1


            c.Close False
        End If
        MyFile = Dir
    Loop
Application.ScreenUpdating = True
End Sub

yylucke

请参见附件

l516605725

yylucke 发表于 2018-6-7 10:38
请参见附件

真是太感谢啦，大神，膜拜你！！这个程序完美~~