VBA-文件操作类自定义函数

1.最近对Excel文件使用较为频繁，故写了几个函数，通过调用可以实现一些基本功能，仅供参考：

（1）遍历指定文件夹下所有文件，并获得文件名（如需要获得指定的文件类型，请增加一个判断条件来判断文件类型）

Function get_filenamelist(rootpath As String) As Collection

Dim fname
Dim namelist As New Collection
fname = Dir(rootpath, vbDirectory)
Do While fname <> ""
'遍历该路径下所有文件，将文件名获取到namelist集合中
    If fname <> "." And fname <> ".." Then
    namelist.Add fname
    End If
'dir 指向下一个文件
    fname = Dir
Loop
Set get_filenamelist = namelist

End Function

（2）批量换表头，即将需要的数据批量复制到指定的列，该函数有四个参数，分别是（表1，需复制的列号，表2，需粘贴的列号）如需批量操作，建议使用两个数组分别存储表1中需要复制的列号和表2中需要粘贴的列号，然后使用for 循环来调用该函数。注意：调用此函数时，若表2的字段名与表1字段名不相同时，建议先将表2表头补充完整，再调用该函数。

Sub colcopy(sheet1 As Worksheet, x1 As Long, sheet2 As Worksheet, x2 As Long)
Dim arr()
Dim r1 As Range, r2 As Range
Dim model As Integer
model = 1
If sheet2.Cells(1, x2) <> "" Then
    model = 0
End If
If model Then
    Set r1 = sheet1.UsedRange.Resize(sheet1.UsedRange.Rows.Count, 1).Offset(0, x1 - 1)
Else
    Set r1 = sheet1.UsedRange.Resize(sheet1.UsedRange.Rows.Count - 1, 1).Offset(1, x1 - 1)
End If
arr = r1
If sheet2.Cells(1, x2) = "" Then
    Set r2 = sheet2.Cells(1, 1).Resize(UBound(arr), 1).Offset(0, x2 - 1)
Else
    Set r2 = sheet2.Cells(1, 1).Resize(UBound(arr), 1).Offset(Val(sheet2.Cells(1, x2).End(xlDown).Row), x2 - 1)
End If
r2 = arr
End Sub

（3）创建文件或打开指定文件，该函数需要传入文件的完整路径，若指定路径下没有该文件，则会自动创建

Public Function createbook(filename As String) As Workbook
    If Dir(filename) = "" Then
        Workbooks.Add
        ActiveWorkbook.SaveAs filename
        Set createbook = ActiveWorkbook
    Else
        Set createbook = Workbooks.Open(filename)
        MsgBox filename & "工作薄已存在！已自动帮您打开！"
    End If
End Function

（4）创建工作表或者打开指定工作表，该函数有两个参数（工作薄，工作表名称），若工作薄里已经有该表格，函数会将该表格作为返回值返回，若没有该表格，则会新建该表格，至于新建以后需要设置表头或者其他操作，可以自行在函数中进行修改。当然也可以实现批量生成表格，也是使用数组来存储表名，然后循环调用该函数就可以实现批量生成了。

Public Function creastesheet(w1 As Workbook, sheetname) As Worksheet
Dim result
result = 1
For Each sheet In w1.Worksheets
    If sheet.Name = sheetname Then
        result = 0
        MsgBox sheetname & "工作表已存在！已自动帮您打开！"
        Set creastesheet = sheet
        Exit For
    End If
Next
If result Then
    Dim sheetn
    Set sheetn = w1.Sheets.Add
    sheetn.Name = sheetname
    Set creastesheet = sheetn
End If

End Function

以上，就是在使用Excel文件中可能会遇到的几种常见操作，在此整理成函数，希望能用！谢谢！