excel较常用vba代码

吸收同目录txt代码
Sub addSht()
Dim Fso As Object, Fl As Object
Dim oClp As Object, Str$, i%, m%

Set Fso = CreateObject("Scripting.FileSystemObject")
Set oClp = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
For Each Fl In Fso.getfolder(ThisWorkbook.Path & "/").Files
If https://www.sodocs.net/doc/cc4295263.html, Like "*.txt" Then
i = i + 1
If i > Sheets.Count Then Sheets.Add after:=Sheets(Sheets.Count)
Sheets(i).Name = Replace(Fso.getfilename(Fl), ".txt", "")
Range("A:Z").NumberFormatLocal = "@"
Open Fl For Input As #1
Str = StrConv(InputB(LOF(1), 1), vbUnicode): Reset
For m = 1 To 10
Str = Replace(Str, " ", " ")
Next
oClp.settext Replace(Str, " ", vbTab)
oClp.putinclipboard
Sheets(i).Paste Sheets(i).[A1]
oClp.Clear
End If
Next

Set oClp = Nothing
End Sub

执行后删除代码
Application.VBE.ActiveVBProject.VBComponents.Remove Application.VBE.ActiveVBProject.VBComponents("模块1")

打开自启动代码
sub auto_open()
call addSht
end sub

另存为代码
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\统计.xls", FileFormat:=xlExcel8

执行后删除代码关闭
With ThisWorkbook
For i = 1 To .VBProject.VBComponents.Count
With .VBProject.VBComponents(i).CodeModule
.DeleteLines 1, .CountOfLines
End With
Next
.Save
End With
Application.Quit


完全版代码

Sub Workbook_Open()
Dim Fso As Object, Fl As Object
Dim oClp As Object, Str$, i%, m%

Set Fso = CreateObject("Scripting.FileSystemObject")
Set oClp = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
For Each Fl In Fso.getfolder(ThisWorkbook.Path & "/").Files
If https://www.sodocs.net/doc/cc4295263.html, Like "*.txt" Then
i = i + 1
If i > Sheets.Count Then Sheets.Add after:=Sheets(Sheets.Count)
Sheets(i).Name = Replace(Fso.getfilename(Fl), ".txt", "")
Open Fl For Input As #1
Str = StrConv(InputB(LOF(1), 1), vbUnicode): Reset
For m = 1 To 10
Str = Replace(Str, " ", " ")
Next
oClp.settext Replace(Str, " ", vbTab)
oClp.putinclipboard
Sheets(i).Paste Sheets(i).[A1]
oClp.Clear
End If
Next

Set oClp = Nothing
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Format(Date, "yyyymmdd") & "统计.xls", FileFormat:=xlExcel8
With ThisWorkbook
For i = 1 To .VBProject.VBComponents.Count
With .VBProject.VBComponents(i).CodeModule
.DeleteLines 1, .CountOfLines
End With
Next
Worksheets(Sheets(1).Name).Select
Range("a1").Select
.Save
End With
Application.Quit
End Sub