1.判断列内是否有重复值:
Dim arrT As Range Dim rng As Range Set arrT = Range("A:A")'判读A列单元格 For Each rng In arrT If rng = Empty Then'如果单元格为空就退出循环,否者循环65535次 Exit For End If k = Application.CountIf(arrT, rng)’用CountIf函数扫描出重复值,跟excel的CountIF函数一样 If k > 1 Then rng.Select MsgBox rng.Address & " has duplicate data.'输出提示信息,程序结束 End End If Next
2.得到指定范围内非空单元格的数量
Dim n As Long n = Application.WorksheetFunction.CountA(Range("A:A")) 'Count of non-empty data in colum A
3.清空指定sheet页
ActiveWorkbook.Worksheets("test").UsedRange.ClearContents
4.连接DB,并将从DB取得的集合放Sheet页的指定行
Set dbConn = CreateObject("ADODB.Connection") Set resSet = CreateObject("ADODB.Recordset") Rem --------------------------------------- strConn = "Provider=MSDAORA.1; user id=" & USER_ID & "; password=" & PASSWORD & "; data source = " & DATA_SOURCE & "; Persist Security Info=True" 'Add reference: Microsoft ActiveX Data Objects 2.8
'Library,Microsoft ActiveX Data Objects Recordset 2.8 Library Rem------------------------------------------ dbConn.Open strConn If dbConn.State <> adStateOpen Then MsgBox "DB Connect failed.Please Add reference: Microsoft ActiveX Data Objects 2.8 Library" connectDB = False End End If 'select sql Set resSet = dbConn.Execute("select * from dual") If (resSet.BOF And resSet.EOF) Then dbConn.Close connectDB = False End End If 'preset result Sheet1.Range("A2").CopyFromRecordset resSet 'close connect dbConn.Close connectDB = True
5.使单元格不可编辑
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 2 Or Target.Column = 3 Or Target.Column = 4 Or Target.Column = 5 Or Target.Column = 6 Or Target.Column = 7 Or Target.Column = 8 Then If Cells(Target.Row, Target.Column) <> "" Then Beep Cells(Target.Row, 1).Offset(0, 0).Select 'MsgBox Cells(Target.Row, Target.Column).Address & " cannot be selected and edited as it is a read-only cell", _ 'vbInformation, "Tool" End If End If End Sub
6.check是不是文件夹或者文件
Public Function FileFolderExists(strFullPath As String) As Boolean On Error GoTo EarlyExit If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True EarlyExit: On Error GoTo 0 End Function
7.文件copy
Set Fso = CreateObject("Scripting.FileSystemObject") Fso.CopyFile fromPath, toPath
8.创建和删除文件夹
Set fs = CreateObject("scripting.filesystemobject") fs.deleteFolder LocalFolderPath fs.createFolder LocalFolderPath
9.用命令创建网络连接盘符
Dim objshell As Object Dim DosExec As Object Set objshell = CreateObject("wscript.shell") Set DosExec = objshell.Exec("cmd.exe /c " & "net use M: " & createPath) Set DosExec = Nothing Set objshell = Nothing