男女中文字幕,亚洲高清成人电影,欧美激情爱爱,国产靠逼大全,亚洲视频,中文字幕,无码视频久久,国产精品揄拍一区二区,人人爱人人做人人草

▎寫在前面

都說寫VBA像累積木，除了核心部分的循環(huán)邏輯思路，其余都是再堆砌代碼。這篇文章就羅列一下我在寫VBA程序中，常用的一些自定義函數(shù)。

?列標相互轉(zhuǎn)換

很多時候得到的列標是數(shù)字列標，需要把它轉(zhuǎn)成英文列標的形式，比如下面的語句中col變量就是數(shù)字。

col = Cells(1, Columns.Count).End(xlToLeft).Column

但是如果我們需要這個數(shù)字所對應(yīng)的英文列標，這個時候就需要下面的自定義函數(shù)進行便捷轉(zhuǎn)化。

自定義函數(shù)代碼：

'列數(shù)轉(zhuǎn)字母Function CNtoW(ByVal num As Long) As String    CNtoW = Replace(Cells(1, num).Address(False, False), "1", "")End Function'字母轉(zhuǎn)列數(shù)Function CWtoN(ByVal AB As String) As Long    CWtoN = Range("a1:" & AB & "1").Cells.CountEnd?Function

代碼使用實例：

Sub test()    col = Cells(1, Columns.Count).End(xlToLeft).Column    Range("a1:" & CNtoW(col) & 1).SelectEnd Sub

?判斷文件夾是否存在

往往存儲運行結(jié)果需要建文件夾的時候，需要首先判斷下文件夾是否存在，如果不判斷直接新建，程序會報錯。

自定義函數(shù)代碼：

Public Function FileFolderExists(ByVal strFullPath As String) As Boolean    If Not Dir(strFullPath, vbDirectory) = vbNullString Then    FileFolderExists = True    Else     FileFolderExists = False    End IfEnd Function

如果不使用自定義函數(shù)，F(xiàn)SO的方式自帶判斷文件夾是否存在的方法

Sub 新建文件夾()    PathG = "D:\folder1"    Set fso = CreateObject("Scripting.FileSystemObject")    If fso.FolderExists(PathG) = True Then        fso.getfolder(PathG).Delete '//刪除文件夾        MkDir PathG '//創(chuàng)建文件夾    Else        MkDir PathG '//創(chuàng)建文件夾    End IfEnd Sub

?判斷文件是否存在

方法一：Dir函數(shù)法

Function IsFileExists(ByVal strFileName As String) As Boolean    If Dir(strFileName) <> Empty Then        IsFileExists = True    Else        IsFileExists = False    End IfEnd Function
Sub Run()    If IsFileExists("D:\vba\abc.txt") = True Then        ' 文件存在時的處理        MsgBox "文件存在！"    Else        ' 文件不存在時的處理        MsgBox "文件不存在！"    End IfEnd Sub

方法二：FSO對象方法

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 IfEnd Function
Sub Run()    If IsFileExists("D:\vba\abc.txt") = True Then        ' 文件存在時的處理        MsgBox "文件存在！"    Else        ' 文件不存在時的處理        MsgBox "文件不存在！"    End IfEnd?Sub

?判斷WorkSheet是否存在

新建WorkSheet的時候，如果已經(jīng)存在相同名字的WorkSheet，程序就會報錯，一般先判斷下某個WorkSheet是否存在，不存在的時候才進行新建操作。

Sub 新建sheet()    If SheetExists("表一") = False Then        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "表一"    End IfEnd SubFunction SheetExists(sname) As Boolean    Dim x As Object    On Error Resume Next    Set x = ActiveWorkbook.Sheets(sname)    If Err = 0 Then SheetExists = True _Else SheetExists = FalseEnd Function

?對數(shù)組進行轉(zhuǎn)置

通常數(shù)組轉(zhuǎn)置都是借助工作表函數(shù)transpose，但是他的限制太多。
1.數(shù)量不能超過65536
2.數(shù)組中元素的長度不能超過255

所以，如果元素過多，就是用自定義數(shù)組轉(zhuǎn)置函數(shù)來解決。


Function Transpose2(arr As Variant)'轉(zhuǎn)置核心代碼    Dim brr(), i, j, n    n = NumberOfArrayDimensions(arr)    If n = 1 Then        ReDim brr(LBound(arr) To UBound(arr), 1 To 1)        For i = LBound(arr) To UBound(arr)            brr(i, 1) = arr(i)        Next    Else        ReDim brr(LBound(arr, 2) To UBound(arr, 2), LBound(arr) To UBound(arr))        For i = LBound(arr) To UBound(arr)            For j = LBound(arr, 2) To UBound(arr, 2)                brr(j, i) = arr(i, j)            Next        Next    End If    Transpose2 = brrEnd FunctionPublic Function NumberOfArrayDimensions(arr As Variant) As Integer    Dim Ndx As Integer    Dim Res As Integer    On Error Resume Next    Do        Ndx = Ndx + 1        Res = UBound(arr, Ndx)    Loop Until Err.Number <> 0    NumberOfArrayDimensions = Ndx - 1End Function

?判斷本機是否聯(lián)網(wǎng)

Private Declare Function InternetGetConnectedState Lib "wininet.dll" _    (ByRef dwFlags As Long, ByVal dwReserved As Long) As Long
Sub 運用VBA判斷計算機是否連網(wǎng)()    If InternetGetConnectedState(0&, 0&) Then        MsgBox "已連網(wǎng)"    Else        MsgBox "未連網(wǎng)"    End IfEnd?Sub

推薦閱讀：（點擊下方標題即可跳轉(zhuǎn)）

【建議收藏】VBA說歷史文章匯總
?速碼工具箱2.0發(fā)布，更強大的功能等你來體驗！
?VBA會被Python代替嗎？
?代碼存儲美化工具測評-【VBE2019】
?Excel和Word數(shù)據(jù)交互讀取（生成合同）

【源碼分享】VBA中一些常用的自定義函數(shù)