您的位置:首页 > 编程语言 > VB

VBA 函数

2016-01-28 21:24 381 查看
自己常用的一些函数。

Option Explicit

'输入完整路径,检查文件是否存在
'#strFileName  完整的路径名
'@存在返回 true 否则返回False
Function isFileExists(ByVal strFileName As String) As Boolean
If Dir(strFileName, 16) <> Empty Then
isFileExists = True
Else
isFileExists = False
End If
End Function

'根据字母返回对应的数字列值
'char 字母值
'@返回对应的列数字值
Public Function Char2Num(char As String) As Long

Char2Num = Range(char & "1").Column

End Function
'根据数字列值返回对应的字母
'colNum 列值
'@返回对应的字母
Public Function Num2Char(colNum As Long) As String

Num2Char = Split(Cells(1, colNum).Address, "$")(1)

End Function

Public Function GetRow_C(ws As Worksheet, letter As String) As Long
'得到某列最后一个非空单元格行值
'letter 列(字母)

GetRow_L = GetRow(ws, LetterToNum(letter))

End Function

'从表的指定列的最后一行向上查找第一个非空单元格行值
'ws     需要查找的Sheet
'pCol   列值
'@返回行数
Public Function GetRow(ws As Worksheet, pCol As Long) As Long

GetRow = ws.Cells(Rows.COUNT, pCol).End(xlUp).Row

End Function

'从表的指定行的最后一列向左查找第一个非空单元格列值
'ws     需要查找的Sheet
'pRow   行值
'@ 返回列数
Public Function GetCol(ws As Worksheet, pRow As Long) As Long

GetCol = ws.Cells(pRow, Columns.COUNT).End(xlToLeft).Column

End Function
'得到某列可见格行数
'pCol 列值
Public Function GetSeeRow(ws As Worksheet, pCol As Long)
Dim rng_1 As Range
Dim rng_2 As Range

Set rng_1 = ws.Cells(1, pCol)
Set rng_2 = ws.Cells(GetRow(ws, pCol), pCol)

GetSeeRow = Range(rng_1, rng_2).SpecialCells(xlCellTypeVisible).Cells.COUNT

End Function

'检查工作簿中是否存名strName 的工作表
'wb         待检查的工作簿引用
'strName    工作表名称
Public Function isSheetExists(wb As Workbook, ByVal shtName As String) As Boolean

Dim flag As Boolean
Dim i As Integer
flag = False

With wb
For i = 1 To .Sheets.COUNT
If .Sheets(i).Name = shtName Then
flag = True
Exit For
End If
Next i
End With

isSheetExists = flag

End Function

'判断工作表是否处于筛选模式
'ws 待检查的工作表对象
'返回bool类型
Public Function isFilter(ws As Worksheet) As Boolean

isFilter = ws.FilterMode

End Function

'添加名为shtName的工作表,若存在则删除
'shtName    要添加的工作表名
'返回新添加的工作表对象
Public Function addSheet(shtName As String) As Worksheet

Dim ws As Worksheet

If isSheetExists(ThisWorkbook, shtName) Then
Worksheets(shtName).Delete
End If

Set ws = Sheets.Add
ws.Name = shtName

Set addSheet = ws

End Function
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: