VBA收藏一常用的自定义函数

Sub 测试()
If IsFileExists("D:\new_temp\") Then
Debug.Print "存在"
Else
Debug.Print "不存在"
End If
End Sub

'参数名称    含义    说明
'strShtName  指定工作表名称  必选
'strWbName   指定工作簿名称  可选
'Sub Demo()
'    Debug.Print udfSheetExists("Sheet1")
'    Debug.Print udfSheetExists("Sheet1", "MyData.xlsx")
'End Sub
Function udfSheetExists(strShtName As String, Optional strWbName As String) As Boolean
    On Error Resume Next
    If strWbName = "" Then
        Set objWb = ActiveWorkbook
    Else
        Set objWb = Workbooks(strWbName)
    End If
    udfSheetExists = CBool(Not objWb.Sheets(strShtName) Is Nothing)
    On Error GoTo 0
End Function
'vba判断文件是否存在的两种方法
Function IsFileExists(ByVal strFileName As String) As Boolean
    If Dir(strFileName, 16) <> Empty Then
        IsFileExists = True
    Else
        IsFileExists = False
    End If
End Function

'Function IsFileExists(ByVal strFileName As String) As Boolean
'    Dim objFileSystem As Object
'    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
'    If objFileSystem.fileExists(strFileName) = True Then
'        IsFileExists = True
'    Else
'        IsFileExists = False
'    End If
'End Function

'判断是否为字母
Public Function isABC(ByVal a)
    If a Like "[A-Za-z]*" Then
        isABC = True
    Else
        isABC = False
    End If
End Function
'vba判断文件是否是xls xlsx xlam文件
Public Function textNorY(str)
    Dim tarr
    tarr = VBA.Split(str, ".")
    s = tarr(UBound(tarr))
    Debug.Print s
    s_num = InStr(str, ":")
    If s = "xls" Or s = "xlsx" Or s = "xlsm" Then
        If s_num = 2 Then
        textNorY = True
        Else
            textNorY = False
        End If
    Else
        textNorY = False
    End If
End Function
'工作表，开始数，终止数，工作表说明，要的数组，要的数组开始行数，0列，1列，2列，3列，4列，5列
Sub into_arr(sht, star_n, end_n, sht_str, temparr, arr_star_n, n0, n1, n2, n3, n4, n5)
    jj = arr_star_n
    With sht
        For i = star_n To end_n
            If .Cells(i, n1) <> "" And .Cells(i, n2) <> "" Then
            temparr(jj, 1) = .Cells(i, n0)
            temparr(jj, 2) = .Cells(i, n1)
            temparr(jj, 3) = .Cells(i, n2)
            temparr(jj, 4) = .Cells(i, n3)
            temparr(jj, 5) = .Cells(i, n4)
            temparr(jj, 6) = .Cells(i, n5)
            temparr(jj, 7) = sht_str
            jj = jj + 1
            End If
        Next i
        
    End With
End Sub
'当前工作表中的删除空行
Sub 删除空行()
    Dim LastRow As Long
    Dim nowRow As Long
    LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    With Application
            .Calculation = xlCalculationManual
            .ScreenUpdating = False        '将屏幕更新关掉
        For nowRow = LastRow To 1 Step -1
           If Application.WorksheetFunction.CountA(Rows(nowRow)) = 0 Then
              Rows(nowRow).Delete
           End If
        Next nowRow
      .Calculation = xlCalculationAutomatic
      .ScreenUpdating = True
    End With
End Sub

Sub 删除空行2(sht)
    Dim LastRow As Long
    Dim nowRow As Long
    With sht
        LastRow = .UsedRange.Row - 1 + .UsedRange.Rows.Count
        For nowRow = LastRow To 1 Step -1
           If Application.WorksheetFunction.CountA(.Rows(nowRow)) = 0 Then
              .Rows(nowRow).Delete
           End If
        Next nowRow
    End With
End Sub