自己常用的一些函数。
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