VBA的几点技巧

1.用VBA出力大文件时的技巧

Execl中的大量行内容经过一些处理后出力到文件时,一件一件写入虽然可以,但影响性能。

可以通过分批写入文件的方法。

Sub outBigData()

Dim content As String

Dim fileName As String;

fileName = "C:\work\test.txt"

Dim i  As Integer

i = 1

while ActiveSteet.Cells(i,4).Value<>""

'逻辑处理循环组装出力内容

content  = content  & Chr(34) &  "aaaaaaaaa" & Chr(34)'双引号

content = content & vbLf '换行符

IF i>=200 and i mod 200=0 Then  ‘每200行出力一次

whiteFile fileName, content

content = ""

End If

i=i+1

Loop

If Not IsEmpty(content) Then

whiteFile fileName, content

End If

End Sub

Sub whiteFile(Byval fileName As String, ByVal content As String)

Open fileName for Append As  #1

Print #1, content ; '注意这里的分号是提示不要自动换行的意思,不用分号就会每次输出文件就多一行空行

Close

End Sub

2.VBA出力的文件是Unicode类型转换成UTF8格式

Sub convertFileUTF8(ByVal inputFile as String, ByVal outPutFile As String)

Dim writeStream As Object

Dim fBytes() As Byte

Dim uniString As String

Dim freeNum as Integer

freeNum = FreeFile

ReDim fBytes(1 to FileLen(inputFile)) '注意这里是从1到文件长度,从0开始就会在输出的文件里多出力一个空格

Open inputFile for Binary Access Read As #freeNum

Get #freeNum, , fBytes '读取文件到Byte数组

Close #freeNum

uniString= StrConv(fBytes,vbUnicode)

Set writeStream = CreateObject("ADODB.Stream")

With writeStream

.Type= 1

.Mode = 3

.Charset = "utf-8"

.Open

.writeText uniString

.SaveToFile outPutFile, 2

.Flush

.Close

End With

Set writeStream = Nothing

End Sub

3.VBA中带有Bom的UTF8文件转换成不带Bom的UTF8文件

Sub removBom(ByVal getPath As String, ByVal putPath As String)

Dim getFileNum As Integer, putFileNum As Integer

Dim fBytes() As Byte

Set fos = CreateObject("Scripting.FileSystemObject")

If fos.FileExists(putPath) Then

Kill putPath'如果转换后文件已经存在就先删除掉

End If

getFileNum  =1

putFileNum  =2

Open getPath for Binary As #getFileNum

Open putPath for Binary As #putFileNum

ReDim fBytes(1 to LOF(getFileNum)-3)  '这里不是从0开始是从1开始的不然转换后文件会多一个空格,-3是因为BOM占3字节

Seek #getFileNum, 4 '跳过文件开头的BOM的3个字节

Get #getFileNum, ,fBytes

Put #putFileNum , ,fBytes

Close #getFileNum

Close #putFileNum

End Sub


VBA写出一个不带BOM头的UTF8文件的另一种写法

Dim myStream As ADODB.Stream

Set mySteam = new ADODB.Stream

myStream.Type = adTypeText

myStream.Charset = “UTF-8”

myStream.Open

for i = 0 to 1000

myStream.WriteText "这是一个测试数据", adWritedLine

Dim byteData() as Byte

myStream.Position=0‘这里是为了把位置跳到内容前面

myStream.Type=adTypeBinary’2进制

myStream.Position=3 '这里是为了跳过前3byte也就是Bom

byteData =  myStream.Read

myStream.Close

myStream.Open

myStream.Write byteData

myStream.SaveToFile filePath, adSaveCreateOverWrite

删除所有链接

Sub delete_name_and_style()

Dim M()

J=ActiveWorkBook.Styles.count

Redim M(J)

For i = 1 to J

M(i) = ActiveWorkbook.Styles(i).Name

for i to J