美文网首页
VBA的几点技巧

VBA的几点技巧

作者: 马云生 | 来源:发表于2022-04-20 11:57 被阅读0次

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

Next

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

     Next

      for i to J

            If Instr("Hyperlink,Normal,Followed Hyperlink", M(i))=0 Then

            ActiveWorkbook.Styles(M(i)).Delete

      End If

     Next

 End Sub

相关文章

网友评论

      本文标题:VBA的几点技巧

      本文链接:https://www.haomeiwen.com/subject/sitvertx.html