vba常用技巧（VBA的几点技巧）

本文目录

• VBA的几点技巧
• 有哪些使用vba提高工作效率的技巧
• Excel vba

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

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

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提高工作效率的技巧

例如需要把所有的工作表名称放到A列，可以用下面的简单VBA实现：

Sub YgB()
    Dim i
    For i = 1 To Sheets.Count
        Cells(i, 1) = Sheets(i).Name
    Next i
End Sub

当表比较多的时候，这个活也是累人的。

稍微修改上面的代码，可以实现把所有表的内容复制到一个表里面。

Excel vba

Private Sub Command1_Click()
Dim strChar As String
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
xlApp.Visible = True
Set xlSheet = xlBook.Worksheets(1)
xlSheet.Activate
xlSheet.Range("b1") = "测试数据" ’测试用的，对你所提问没有没有关系

xlSheet.Range("b1:b15").Merge ’测试用的，对你所提问没有没有关系，合并单元格（B1;b15）

xlSheet.Range("b1:b15").UnMerge ’分解单元格，原内容自动填充到分解后的第一单元格.这句也是你问题的答案，不过你要根据你的具体情况改变“("b1:b15")”

xlSheet.Range("c:c").Merge ’测试用的，对你所提问没有没有关系

xlSheet.Range("c:c").UnMerge ’这句是你的第二问的答案。具体含义是拆分第C列,这句也要根据你的具体情况改变“("c:c")”，既把引号内的括号内的c改成其他英文字母。

Set xlBook = Nothing
xlApp.Quit
End Sub
备注：我用的excel2007，excel2003应该一样。给你说一个小技巧，你用VBA技术时，你可以先录制一个宏，然后在宏的基础上和你的具体需要更改你录制的宏代码，然后复制到你写的代码中就可以了，不过前提是你知道一些VBA基础知识。