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
